Changeset 530 for trunk/AGRIF/LIB/fortran.y
- Timestamp:
- 2006-10-17T17:36:11+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/AGRIF/LIB/fortran.y (modified) (106 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/LIB/fortran.y
r396 r530 3 3 /* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ 4 4 /* */ 5 /* Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)*/5 /* Copyright or © or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ 6 6 /* Cyril Mazauric (Cyril.Mazauric@imag.fr) */ 7 /* This software is governed by the CeCILL-C license under French law and */ 8 /* abiding by the rules of distribution of free software. You can use, */ 9 /* modify and/ or redistribute the software under the terms of the CeCILL-C */ 10 /* license as circulated by CEA, CNRS and INRIA at the following URL */ 11 /* "http://www.cecill.info". */ 7 12 /* */ 8 /* This program is free software; you can redistribute it and/or modify */ 9 /* it */ 13 /* As a counterpart to the access to the source code and rights to copy, */ 14 /* modify and redistribute granted by the license, users are provided only */ 15 /* with a limited warranty and the software's author, the holder of the */ 16 /* economic rights, and the successive licensors have only limited */ 17 /* liability. */ 10 18 /* */ 11 /* This program is distributed in the hope that it will be useful, */ 12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ 13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ 14 /* GNU General Public License for more details. */ 19 /* In this respect, the user's attention is drawn to the risks associated */ 20 /* with loading, using, modifying and/or developing or reproducing the */ 21 /* software by the user in light of its specific status of free software, */ 22 /* that may mean that it is complicated to manipulate, and that also */ 23 /* therefore means that it is reserved for developers and experienced */ 24 /* professionals having in-depth computer knowledge. Users are therefore */ 25 /* encouraged to load and test the software's suitability as regards their */ 26 /* requirements in conditions enabling the security of their systems and/or */ 27 /* data to be ensured and, more generally, to use and operate it in the */ 28 /* same conditions as regards security. */ 15 29 /* */ 30 /* The fact that you are presently reading this means that you have had */ 31 /* knowledge of the CeCILL-C license and that you accept its terms. */ 32 /******************************************************************************/ 33 /* version 1.0 */ 16 34 /******************************************************************************/ 17 35 %{ … … 40 58 listvarcommon *lcom; 41 59 listnom *ln; 42 listvarpointtovar *lp;43 60 listcouple *lc; 44 61 typedim dim1; … … 97 114 %token TOK_ACOS 98 115 %token TOK_NINT 116 %token TOK_CYCLE 99 117 %token TOK_SIN 100 118 %token TOK_SINH 101 119 %token TOK_ASIN 102 120 %token TOK_EQUIVALENCE 121 %token TOK_BACKSPACE 103 122 %token TOK_LOG 104 123 %token TOK_TAN … … 156 175 %token TOK_SAVE 157 176 %token TOK_TARGET 158 %token TOK_USE159 177 %token TOK_POINT 160 178 %token TOK_DATA … … 166 184 %token TOK_POINT_TO 167 185 %token TOK_COMMON 186 %token TOK_GLOBAL 168 187 %token TOK_INTERFACE 169 188 %token TOK_ENDINTERFACE … … 174 193 %token TOK_STOP 175 194 %token TOK_NAMEEQ 195 %token TOK_REAL8 196 %token <na> TOK_USE 176 197 %token <na> TOK_DSLASH 177 198 %token <na> TOK_DASTER … … 235 256 %token '>' 236 257 %type <l> dcl 258 %type <l> dimension 237 259 %type <l> paramlist 238 260 %type <l> args … … 244 266 %type <lcom> var_common 245 267 %type <lcom> var_common_list 268 %type <d> dims 269 %type <d> dimlist 270 %type <dim1> dim 271 %type <v> paramitem 246 272 %type <na> comblock 247 273 %type <na> name_routine … … 286 312 %type <na> intent_spec 287 313 %type <na> ubound 288 %type <na> after_ident_dims289 314 %type <na> signe 290 315 %type <na> opt_signe … … 292 317 %type <na> filename 293 318 %type <na> proper_lengspec 294 %type <d> dims295 %type <d> dimlist296 %type <dim1> dim297 %type <v> paramitem298 319 299 320 %left TOK_OP … … 303 324 ; 304 325 line : '\n' position 305 | thislabel suite_line 326 | thislabel suite_line_list 306 327 | TOK_COMMENT 307 328 | keyword cmnt writedeclar … … 309 330 {yyerrok;yyclearin;} 310 331 ; 332 suite_line_list : suite_line 333 | suite_line ';' suite_line_list 334 ; 311 335 suite_line : entry fin_line/* subroutine, function, module */ 312 336 | spec fin_line /* declaration */ 313 337 | before_include filename fin_line 314 338 { 315 if (firstpass == 0 && 316 inmoduledeclare == 0 && 339 if (inmoduledeclare == 0 && 317 340 couldaddvariable == 1 ) 318 341 { 319 342 pos_end = setposcur(); 320 RemoveWordSET (fortranout,pos_curinclude,343 RemoveWordSET_0(fortranout,pos_curinclude, 321 344 pos_end-pos_curinclude); 322 345 } … … 334 357 /* TOK_ENDDONOTTREAT */ 335 358 couldaddvariable = 0 ; 336 if ( firstpass == 0 ) 337 { 338 RemoveWordCUR(fortranout,-20,20); 339 } 359 RemoveWordCUR_0(fortranout,-20,20); 340 360 } 341 361 | TOK_ENDDONOTTREAT 342 362 { 343 363 couldaddvariable = 1 ; 344 if ( firstpass == 0 ) 345 { 346 RemoveWordCUR(fortranout,-24,24); 347 } 364 RemoveWordCUR_0(fortranout,-24,24); 348 365 } 349 366 | TOK_OMP 350 367 | TOK_DOLLAR 351 368 ; 352 position: { if ( firstpass == 0 )pos_cur = setposcur();}369 position: {pos_cur = setposcur();} 353 370 ; 354 371 thislabel: … … 374 391 paramdeclaration_everdone = 0; 375 392 insubroutinedeclare = 1; 376 if ( firstpass == 0 ) 377 { 378 adduseagrifutil = 0 ; 379 AGRIF_n_AddUseAgrifUtil(); 380 } 393 AddUseAgrifUtil_0(); 381 394 /* in the second step we should write the head of */ 382 395 /* the subroutine sub_loop_<subroutinename> */ 383 OPTI_0_writeheadnewsubforsub();396 writeheadnewsub_0(1); 384 397 adduseagrifutil = 0 ; 385 398 } … … 389 402 paramdeclaration_everdone = 0; 390 403 insubroutinedeclare = 1; 391 if ( firstpass == 0 ) 392 { 393 adduseagrifutil = 0 ; 394 AGRIF_n_AddUseAgrifUtil(); 395 } 396 OPTI_0_writeheadnewsubforsub(); 404 AddUseAgrifUtil_0(); 405 writeheadnewsub_0(1); 397 406 adduseagrifutil = 0 ; 398 407 } … … 406 415 paramdeclaration_everdone = 0; 407 416 insubroutinedeclare = 1; 408 if ( firstpass == 0 ) 409 { 410 adduseagrifutil = 0 ; 411 AGRIF_n_AddUseAgrifUtil(); 412 } 417 AddUseAgrifUtil_0(); 413 418 /* in the second step we should write the head of */ 414 419 /* the subroutine sub_loop_<subroutinename> */ 415 OPTI_0_writeheadnewsubforsub();420 writeheadnewsub_0(1); 416 421 adduseagrifutil = 0 ; 417 422 } … … 425 430 paramdeclaration_everdone = 0; 426 431 insubroutinedeclare = 1; 427 if ( firstpass == 0 ) 428 { 429 adduseagrifutil = 0 ; 430 AGRIF_n_AddUseAgrifUtil(); 431 } 432 AddUseAgrifUtil_0(); 432 433 /* we should to list of the subroutine argument the */ 433 434 /* name of the function which has to be defined */ … … 440 441 /* in the second step we should write the head of */ 441 442 /* the subroutine sub_loop_<subroutinename> */ 442 OPTI_0_writeheadnewsubforfunc();443 writeheadnewsub_0(2); 443 444 adduseagrifutil = 0 ; 444 445 } … … 446 447 { 447 448 tmpdeclaration_everdone = 0; 448 paramdeclaration_everdone = 0;449 paramdeclaration_everdone = 0; 449 450 insubroutinedeclare = 1; 450 if ( firstpass == 0 ) 451 { 452 adduseagrifutil = 0 ; 453 AGRIF_n_AddUseAgrifUtil(); 454 } 451 AddUseAgrifUtil_0(); 455 452 /* we should to list of the subroutine argument */ 456 453 /* name of the function which has to be defined */ … … 462 459 (curlistvar,listargsubroutine,1); 463 460 } 464 OPTI_0_writeheadnewsubforfunc();461 writeheadnewsub_0(2); 465 462 adduseagrifutil = 0 ; 466 463 } … … 475 472 paramdeclaration_everdone = 0; 476 473 insubroutinedeclare = 1; 477 if ( firstpass == 0 ) 478 { 479 adduseagrifutil = 0 ; 480 AGRIF_n_AddUseAgrifUtil(); 481 } 474 AddUseAgrifUtil_0(); 482 475 /* we should to list of the subroutine argument the */ 483 476 /* name of the function which has to be defined */ … … 491 484 /* in the second step we should write the head of */ 492 485 /* the subroutine sub_loop_<subroutinename> */ 493 OPTI_0_writeheadnewsubforfunc();486 writeheadnewsub_0(2); 494 487 adduseagrifutil = 0 ; 495 488 } … … 497 490 { 498 491 tmpdeclaration_everdone = 0; 499 paramdeclaration_everdone = 0;492 paramdeclaration_everdone = 0; 500 493 insubroutinedeclare = 1; 501 if ( firstpass == 0 ) 502 { 503 adduseagrifutil = 0 ; 504 AGRIF_n_AddUseAgrifUtil(); 505 } 494 AddUseAgrifUtil_0(); 506 495 /* we should to list of the subroutine argument */ 507 496 /* name of the function which has to be defined */ … … 513 502 (curlistvar,listargsubroutine,1); 514 503 } 515 OPTI_0_writeheadnewsubforfunc();504 writeheadnewsub_0(2); 516 505 adduseagrifutil = 0 ; 517 506 } … … 520 509 { 521 510 strcpy(curmodulename,$2); 522 if ( firstpass == 1 ) Add_ModuleTo_Modulelist($2);511 Add_ModuleTo_Modulelist_1($2); 523 512 if ( inmoduledeclare == 0 ) 524 513 { 525 /* instance and back instance should be create ?*/526 MOD_1_FillInlistmodule();514 /* Alloc should be create ? */ 515 FillInlistmodule_1(); 527 516 /* To know if there are in the module declaration */ 528 517 inmoduledeclare = 1; … … 533 522 } 534 523 /* WE should use Agrif_Util if it is necessary */ 535 A GRIF_0_AddUseAgrifInModuleDeclaration();524 AddUseAgrifInModuleDeclaration_0(); 536 525 } 537 526 ; … … 541 530 before_include : TOK_INCLUDE 542 531 { 543 if (firstpass == 0 ) 544 { 545 pos_curinclude = setposcur()-9; 546 } 532 pos_curinclude = setposcur()-9; 547 533 } 548 534 filename: TOK_CHAR_CONSTANT 549 535 { 550 if ( firstpass == 1 &&couldaddvariable == 1 )551 { 552 Addincludetothelist ($1);536 if ( couldaddvariable == 1 ) 537 { 538 Addincludetothelist_1($1); 553 539 } 554 540 } … … 595 581 /* remove declaration */ 596 582 if ( fortran77 == 1 && 597 firstpass == 0 &&598 583 infunctiondeclare == 0 && 599 584 commonlist && 600 OPTI_0_IsTabvarsUseInArgument() == 1&&585 IsTabvarsUseInArgument_0() == 1 && 601 586 couldaddvariable == 1 ) 602 587 { 603 588 pos_end = setposcur(); 604 RemoveWordSET (fortranout,pos_cur_decl,589 RemoveWordSET_0(fortranout,pos_cur_decl, 605 590 pos_end-pos_cur_decl); 606 591 } … … 608 593 } 609 594 | TOK_TYPE opt_name 595 /* { 596 couldaddvariable = 0; 597 }*/ 610 598 | TOK_ENDTYPE opt_name 599 /* { 600 couldaddvariable = 1; 601 }*/ 611 602 | TOK_POINTER list_couple 612 603 | before_parameter '(' paramlist ')' 613 604 { 614 COM_1_AddvartoParamlist($3);605 AddvartoParamlist_1($3); 615 606 if ( fortran77 == 1 && 616 firstpass == 0 &&617 607 commonlist && 618 608 listvarindoloop && 619 OPTI_0_IsTabvarsUseInArgument() == 1 )609 IsTabvarsUseInArgument_0() == 1 ) 620 610 { 621 611 pos_end = setposcur(); 622 RemoveWordSET(fortranout,pos_curparameter, 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, 623 626 pos_end-pos_curparameter); 624 627 } … … 628 631 | implicit 629 632 | dimension 633 { 634 /* if the variable is a parameter we can suppose that is */ 635 /* value is the same on each grid. It is not useless to */ 636 /* create a copy of it on each grid */ 637 if ( couldaddvariable == 1 ) 638 { 639 ajoutevar_1($1); 640 NonGridDepDeclaration_0($1); 641 /* if variables has been declared in a subroutine */ 642 if ( insubroutinedeclare == 1 ) 643 { 644 ajoutvarofsubroutine_1($1); 645 writesubroutinedeclaration_0($1); 646 } 647 } 648 /* Case of common block */ 649 indeclarationvar=0; 650 PublicDeclare = 0; 651 PrivateDeclare = 0; 652 ExternalDeclare = 0; 653 strcpy(NamePrecision,""); 654 c_star = 0; 655 InitialValueGiven = 0 ; 656 strcpy(IntentSpec,""); 657 VariableIsParameter = 0 ; 658 Allocatabledeclare = 0 ; 659 SaveDeclare = 0; 660 pointerdeclare = 0; 661 optionaldeclare = 0 ; 662 dimsgiven=0; 663 c_selectorgiven=0; 664 strcpy(nameinttypename,""); 665 } 630 666 | public 631 667 | private … … 634 670 | interface 635 671 | namelist 672 | TOK_BACKSPACE '(' expr ')' 636 673 | TOK_EXTERNAL opt_sep use_name_list 674 | TOK_INTRINSIC opt_sep use_intrinsic_list 637 675 | TOK_EQUIVALENCE '(' list_expr ')' 638 676 | before_data data '\n' 639 677 { 640 678 /* we should remove the data declaration */ 641 if ( firstpass == 0 &&aftercontainsdeclare == 0 )679 if ( aftercontainsdeclare == 0 ) 642 680 { 643 681 pos_end = setposcur(); 644 RemoveWordSET (fortranout,pos_curdata,682 RemoveWordSET_0(fortranout,pos_curdata, 645 683 pos_end-pos_curdata); 646 684 } 647 685 } 648 686 ; 687 name_intrinsic : TOK_SUM 688 | TOK_TANH 689 | TOK_MAXVAL 690 | TOK_MIN 691 | TOK_MINVAL 692 | TOK_TRIM 693 | TOK_SQRT 694 | TOK_NINT 695 | TOK_FLOAT 696 | TOK_EXP 697 | TOK_COS 698 | TOK_COSH 699 | TOK_ACOS 700 | TOK_SIN 701 | TOK_SINH 702 | TOK_ASIN 703 | TOK_LOG 704 | TOK_TAN 705 | TOK_ATAN 706 | TOK_MOD 707 | TOK_SIGN 708 | TOK_MINLOC 709 | TOK_MAXLOC 710 | TOK_NAME 711 ; 712 use_intrinsic_list : name_intrinsic 713 | use_intrinsic_list ',' name_intrinsic 649 714 list_couple : '(' list_expr ')' 650 715 | list_couple ',' '(' list_expr ')' … … 661 726 if ( couldaddvariable == 1 ) 662 727 { 663 decl_1_ajoutevar($1);728 ajoutevar_1($1); 664 729 if ( VariableIsParameter == 1 ) globparam = 665 730 AddListvarToListvar($1,globparam,1); 666 DECL_0_NonGridDepDeclaration($1);731 NonGridDepDeclaration_0($1); 667 732 /* if variables has been declared in a subroutine */ 668 733 if ( insubroutinedeclare == 1 ) 669 734 { 670 OPTI_1_ajoutvarofsubroutine($1);671 OPTI_0_writesubroutinedeclaration($1);735 ajoutvarofsubroutine_1($1); 736 writesubroutinedeclaration_0($1); 672 737 } 673 738 /* If there are a SAVE declarations in module's */ … … 677 742 if ( aftercontainsdeclare == 1 ) 678 743 { 679 decl_1_ajoutevarsave($1); 680 decl_0_modifdeclarationssave($1); 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 } 681 751 } 682 752 } … … 686 756 PrivateDeclare = 0; 687 757 ExternalDeclare = 0; 688 lengspecgiven=0; 689 PrecisionGiven = 0; 758 strcpy(NamePrecision,""); 690 759 c_star = 0; 691 CharacterSizeGiven = 0 ;692 760 InitialValueGiven = 0 ; 693 IntentDeclare = 0;761 strcpy(IntentSpec,""); 694 762 VariableIsParameter = 0 ; 695 763 Allocatabledeclare = 0 ; … … 699 767 dimsgiven=0; 700 768 c_selectorgiven=0; 701 inttypename=0;769 strcpy(nameinttypename,""); 702 770 } 703 771 | TOK_FUNCTION TOK_NAME arglist … … 711 779 paramdeclaration_everdone = 0; 712 780 insubroutinedeclare = 1; 713 if ( firstpass == 0 ) 714 { 715 adduseagrifutil = 0 ; 716 AGRIF_n_AddUseAgrifUtil(); 717 } 781 AddUseAgrifUtil_0(); 718 782 /* we should to list of the subroutine argument the */ 719 783 /* name of the function which has to be defined */ … … 740 804 /* in the second step we should write the head of */ 741 805 /* the subroutine sub_loop_<subroutinename> */ 742 OPTI_0_writeheadnewsubforfunc();806 writeheadnewsub_0(2); 743 807 adduseagrifutil = 0 ; 744 808 } … … 748 812 paramdeclaration_everdone = 0; 749 813 insubroutinedeclare = 1; 750 if ( firstpass == 0 ) 751 { 752 adduseagrifutil = 0 ; 753 AGRIF_n_AddUseAgrifUtil(); 754 } 814 AddUseAgrifUtil_0(); 755 815 /* we should to list of the subroutine argument the */ 756 816 /* name of the function which has to be defined */ … … 771 831 /* in the second step we should write the head of */ 772 832 /* the subroutine sub_loop_<subroutinename> */ 773 OPTI_0_writeheadnewsubforfunc();833 writeheadnewsub_0(2); 774 834 adduseagrifutil = 0 ; 775 835 } … … 778 838 before_parameter : TOK_PARAMETER 779 839 { 780 if (firstpass == 0 ) 781 { 782 pos_curparameter = setposcur()-9; 783 } 840 pos_curparameter = setposcur()-9; 784 841 } 785 842 before_data : TOK_DATA 786 843 { 787 if (firstpass == 0 )pos_curdata = setposcur()-4;844 pos_curdata = setposcur()-4; 788 845 } 789 846 data: TOK_NAME TOK_SLASH datavallist TOK_SLASH 790 847 { 791 848 sprintf(ligne,"(/ %s /)",$3); 792 DATA_n_CompleteDataList($1,ligne);849 CompleteDataList($1,ligne); 793 850 } 794 851 | data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH 795 852 { 796 853 sprintf(ligne,"(/ %s /)",$5); 797 DATA_n_CompleteDataList($3,ligne); 798 } 854 CompleteDataList($3,ligne); 855 } 856 | datanamelist TOK_SLASH datavallist TOK_SLASH 857 { 858 /*******************************************************/ 859 /*******************************************************/ 860 /*******************************************************/ 861 /*******************************************************/ 862 /*******************************************************/ 863 /*******************************************************/ 864 /*******************************************************/ 865 } 866 ; 867 datanamelist : TOK_NAME 868 | datanamelist ',' TOK_NAME 799 869 ; 800 870 datavallist : expr_data … … 812 882 {sprintf($$,"%s+%s",$1,$3);} 813 883 | expr_data '-' expr_data 814 {sprintf($$,"%s +%s",$1,$3);}884 {sprintf($$,"%s-%s",$1,$3);} 815 885 | expr_data '*' expr_data 816 {sprintf($$,"%s +%s",$1,$3);}886 {sprintf($$,"%s*%s",$1,$3);} 817 887 | expr_data '/' expr_data 818 {sprintf($$,"%s +%s",$1,$3);}888 {sprintf($$,"%s/%s",$1,$3);} 819 889 ; 820 890 opt_signe : … … 828 898 | TOK_NAMELIST comblock ident 829 899 { 830 if ( firstpass == 1 ) AddNameToListNamelist($2);900 AddNameToListNamelist_1($2); 831 901 } 832 902 | namelist_action opt_comma comblock opt_comma ident 833 903 { 834 if ( firstpass == 1 ) AddNameToListNamelist($3);904 AddNameToListNamelist_1($3); 835 905 } 836 906 | namelist_action ',' ident … … 842 912 ; 843 913 dimension: TOK_DIMENSION opt_comma TOK_NAME dims lengspec 914 { 915 if ( couldaddvariable == 1 ) 916 { 917 if ( inmoduledeclare == 1 || SaveDeclare == 1 ) 918 { 919 if ( AllocShouldMadeInModule() == 1 ) 920 { 921 AllocTo1InModule_1(); 922 } 923 } 924 /* */ 925 curvar=createvar($3,$4); 926 /* */ 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 } 945 strcpy(vallengspec,""); 946 } 947 else 948 { 949 /* mazauric*/ 950 } 951 } 844 952 | dimension ',' TOK_NAME dims lengspec 953 { 954 if ( couldaddvariable == 1 ) 955 { 956 /* */ 957 curvar=createvar($3,$4); 958 /* */ 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 } 977 strcpy(vallengspec,""); 978 } 979 else 980 { 981 /* mazauric*/ 982 } 983 } 845 984 ; 846 985 private: TOK_PRIVATE '\n' 847 | TOK_PRIVATE use_name_list986 | TOK_PRIVATE opt_sep use_name_list 848 987 ; 849 988 public: TOK_PUBLIC '\n' 850 | TOK_PUBLIC use_name_list989 | TOK_PUBLIC opt_sep use_name_list 851 990 ; 852 991 use_name_list: TOK_NAME … … 855 994 common: before_common var_common_list 856 995 { 857 if (f irstpass == 0 && fortran77 == 1 &&996 if (fortran77 == 1 && 858 997 couldaddvariable == 1 ) 859 998 { 860 999 pos_end = setposcur(); 861 RemoveWordSET (fortranout,pos_curcommon,1000 RemoveWordSET_0(fortranout,pos_curcommon, 862 1001 pos_end-pos_curcommon); 863 1002 } … … 867 1006 if ( couldaddvariable == 1 ) 868 1007 { 869 if (firstpass == 1 ) 870 { 871 sprintf(charusemodule,"%s",$2); 872 Add_ModuleTo_Modulelist($2); 873 } 874 if (firstpass == 0 && fortran77 == 1 ) 1008 sprintf(charusemodule,"%s",$2); 1009 Add_ModuleTo_Modulelist_1($2); 1010 if ( fortran77 == 1 ) 875 1011 { 876 1012 pos_end = setposcur(); 877 RemoveWordSET (fortranout,pos_curcommon,1013 RemoveWordSET_0(fortranout,pos_curcommon, 878 1014 pos_end-pos_curcommon); 879 1015 } … … 884 1020 if ( couldaddvariable == 1 ) 885 1021 { 886 if (firstpass == 1 ) 887 { 888 sprintf(charusemodule,"%s",$3); 889 Add_ModuleTo_Modulelist($3); 890 } 891 if (firstpass == 0 && fortran77 == 1 ) 1022 sprintf(charusemodule,"%s",$3); 1023 Add_ModuleTo_Modulelist_1($3); 1024 if ( fortran77 == 1 ) 892 1025 { 893 1026 pos_end = setposcur(); 894 RemoveWordSET (fortranout,pos_curcommon,1027 RemoveWordSET_0(fortranout,pos_curcommon, 895 1028 pos_end-pos_curcommon); 896 1029 } … … 901 1034 { 902 1035 positioninblock=0; 903 if (firstpass == 0 ) pos_curcommon = setposcur()-6; 904 } 1036 pos_curcommon = setposcur()-6; 1037 } 1038 | TOK_GLOBAL TOK_COMMON 1039 { 1040 positioninblock=0; 1041 pos_curcommon = setposcur()-6-7; 1042 } 1043 ; 905 1044 var_common_list : var_common 906 1045 { 907 if ( couldaddvariable == 1 ) COM_1_AddCommonvartolist();1046 if ( couldaddvariable == 1 ) Addtolistvarcommon(); 908 1047 } 909 1048 910 1049 | var_common_list ',' var_common 911 1050 { 912 if ( couldaddvariable == 1 ) COM_1_AddCommonvartolist();1051 if ( couldaddvariable == 1 ) Addtolistvarcommon(); 913 1052 } 914 1053 var_common: TOK_NAME dims … … 947 1086 ; 948 1087 varsave: 949 | TOK_NAME dims 1088 | TOK_NAME before_dims dims 1089 {created_dimensionlist = 1;} 950 1090 ; 951 1091 … … 970 1110 strcpy(curvar->subroutinename,subroutinename); 971 1111 strcpy(curvar->modulename,subroutinename); 972 curvar->isparameter=1;973 1112 strcpy(curvar->initialvalue,$3); 974 1113 $$=curvar; … … 985 1124 if ( firstpass == 1 && insubroutinedeclare == 1 ) 986 1125 { 987 listimplicitnone = Add _listname1126 listimplicitnone = Addtolistname 988 1127 (subroutinename,listimplicitnone); 989 1128 } 990 if ( firstpass == 0 && 991 tmpdeclaration_everdone == 1 && 1129 if ( tmpdeclaration_everdone == 1 && 992 1130 inmoduledeclare == 0 ) 993 1131 { 994 1132 pos_end = setposcur(); 995 RemoveWordSET (fortranout,pos_end-13,1133 RemoveWordSET_0(fortranout,pos_end-13, 996 1134 13); 997 1135 } 998 1136 } 1137 | TOK_IMPLICIT TOK_REAL8 999 1138 ; 1000 1139 opt_retour : … … 1006 1145 if ( inmoduledeclare == 1 || SaveDeclare == 1 ) 1007 1146 { 1008 if ( MOD_n_InstanceShouldMadeInModule() == 1 )1147 if ( AllocShouldMadeInModule() == 1 ) 1009 1148 { 1010 MOD_1_InstanceTo1InModule();1149 AllocTo1InModule_1(); 1011 1150 } 1012 1151 } … … 1036 1175 $$=settype(DeclType,curlistvar); 1037 1176 } 1038 lengspecgiven=0; 1177 else 1178 { 1179 /* mazauric*/ 1180 } 1039 1181 strcpy(vallengspec,""); 1040 1182 } … … 1054 1196 CreateAndFillin_Curvar($1->var->typevar,$4,$5,curvar); 1055 1197 /* */ 1056 curvar->typegiven=1;1057 1198 strcpy(curvar->typevar,($1->var->typevar)); 1058 1199 /* */ … … 1070 1211 $$=curlistvar; 1071 1212 } 1072 lengspecgiven=0; 1213 else 1214 { 1215 /* mazauric*/ 1216 } 1073 1217 strcpy(vallengspec,""); 1074 1218 } … … 1084 1228 if (inmoduledeclare == 1 ) 1085 1229 { 1086 MOD_1_InstanceShouldMadeTo1InModule();1230 AllocShouldMadeTo1InModule_1(); 1087 1231 } 1088 1232 } … … 1091 1235 indeclarationvar=1; 1092 1236 strcpy(DeclType,$1); 1093 inttypename=1;1094 1237 strcpy(nameinttypename,$3); 1095 1238 } … … 1107 1250 before_character : TOK_CHARACTER 1108 1251 { 1109 if ( firstpass == 0 ) 1110 { 1111 pos_cur_decl = setposcur(); 1112 pos_cur_decl = pos_cur_decl-9; 1113 } 1252 pos_cur_decl = setposcur()-9; 1114 1253 } 1115 1254 ; … … 1119 1258 { 1120 1259 strcpy($$,"INTEGER"); 1121 if ( firstpass == 0 ) 1122 { 1123 pos_cur_decl = setposcur(); 1124 pos_cur_decl = pos_cur_decl-7; 1125 } 1260 pos_cur_decl = setposcur()-7; 1126 1261 if (inmoduledeclare == 1 ) 1127 1262 { 1128 MOD_1_InstanceShouldMadeTo1InModule();1263 AllocShouldMadeTo1InModule_1(); 1129 1264 } 1130 1265 } 1131 1266 | TOK_REAL { 1132 1267 strcpy($$,"REAL"); 1133 if ( firstpass == 0 ) 1134 { 1135 pos_cur_decl = setposcur(); 1136 pos_cur_decl = pos_cur_decl-4; 1137 } 1268 pos_cur_decl = setposcur()-4; 1138 1269 if (inmoduledeclare == 1 ) 1139 1270 { 1140 MOD_1_InstanceShouldMadeTo1InModule();1271 AllocShouldMadeTo1InModule_1(); 1141 1272 } 1142 1273 } … … 1150 1281 { 1151 1282 strcpy($$,"LOGICAL"); 1152 if ( firstpass == 0 ) 1153 { 1154 pos_cur_decl = setposcur(); 1155 pos_cur_decl = pos_cur_decl-7; 1156 } 1283 pos_cur_decl = setposcur()-7; 1157 1284 if (inmoduledeclare == 1 ) 1158 1285 { 1159 MOD_1_InstanceShouldMadeTo1InModule();1286 AllocShouldMadeTo1InModule_1(); 1160 1287 } 1161 1288 } 1162 1289 | TOK_TYPE 1163 1290 { 1164 if ( firstpass == 0 ) 1165 { 1166 pos_cur_decl = setposcur(); 1167 pos_cur_decl = pos_cur_decl-5; 1168 } 1291 pos_cur_decl = setposcur()-5; 1169 1292 strcpy($$,"TYPE"); 1170 1293 } 1171 1294 ; 1172 1295 lengspec: 1173 | '*' proper_lengspec { lengspecgiven=1;strcpy(vallengspec,$2);}1296 | '*' proper_lengspec {strcpy(vallengspec,$2);} 1174 1297 ; 1175 1298 proper_lengspec: expr {sprintf($$,"*%s",$1);} … … 1186 1309 | TOK_NAME '=' clause 1187 1310 { 1188 PrecisionGiven = 1;1189 1311 sprintf(NamePrecision,"%s = %s",$1,$3); 1190 1312 } 1191 1313 | TOK_NAME 1192 1314 { 1193 PrecisionGiven = 1;1194 1315 strcpy(NamePrecision,$1); 1195 1316 } 1317 | TOK_CSTINT 1318 { 1319 strcpy(NamePrecision,$1); 1320 } 1196 1321 ; 1197 1322 clause: expr {strcpy(CharacterSize,$1); 1198 CharacterSizeGiven = 1;strcpy($$,$1);}1323 strcpy($$,$1);} 1199 1324 | '*' {strcpy(CharacterSize,"*"); 1200 CharacterSizeGiven = 1;strcpy($$,"*");}1325 strcpy($$,"*");} 1201 1326 ; 1202 1327 opt_clause: … … 1215 1340 if (inmoduledeclare == 1 ) 1216 1341 { 1217 MOD_1_InstanceShouldMadeTo0InModule();1342 AllocShouldMadeTo0InModule_1(); 1218 1343 } 1219 1344 } … … 1228 1353 | TOK_EXTERNAL 1229 1354 {ExternalDeclare = 1;} 1230 | TOK_INTENT '(' intent_spec ')'1231 { IntentDeclare = 1; strcpy(IntentSpec,$3);}1355 | TOK_INTENT intent_spec 1356 {strcpy(IntentSpec,$2);} 1232 1357 | TOK_INTRINSIC 1233 1358 | TOK_OPTIONAL{optionaldeclare = 1 ;} … … 1238 1363 SaveDeclare = 1 ; 1239 1364 Savemeet = 1; 1240 MOD_1_InstanceShouldMadeTo1InModule();1365 AllocShouldMadeTo1InModule_1(); 1241 1366 } 1242 1367 } … … 1252 1377 {PrivateDeclare = 1;} 1253 1378 ; 1254 dims: { $$=(listdim *)NULL;}1379 dims: {if ( created_dimensionlist == 1 ) $$=(listdim *)NULL;} 1255 1380 | '(' dimlist ')' 1256 { $$=reverse($2);}1257 ; 1258 dimlist: dim { $$=insertdim(NULL,$1);}1381 {if ( created_dimensionlist == 1 ) $$=$2;} 1382 ; 1383 dimlist: dim {if ( created_dimensionlist == 1 ) $$=insertdim(NULL,$1);} 1259 1384 | dimlist ',' dim 1260 { $$=insertdim($1,$3);}1385 {if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);} 1261 1386 ; 1262 1387 dim:ubound {strcpy($$.first,"1");strcpy($$.last,$1);} … … 1280 1405 predefinedfunction : TOK_SUM minmaxlist ')' 1281 1406 {sprintf($$,"SUM(%s)",$2);} 1282 | TOK_MAX '('minmaxlist ')'1283 {sprintf($$,"MAX(%s)",$ 3);}1407 | TOK_MAX minmaxlist ')' 1408 {sprintf($$,"MAX(%s)",$2);} 1284 1409 | TOK_TANH '(' minmaxlist ')' 1285 1410 {sprintf($$,"TANH(%s)",$3);} … … 1292 1417 | TOK_TRIM '(' expr ')' 1293 1418 {sprintf($$,"TRIM(%s)",$3);} 1294 | TOK_SQRT '('expr ')'1295 {sprintf($$,"SQRT(%s)",$ 3);}1296 | TOK_REAL '(' expr')'1419 | TOK_SQRT expr ')' 1420 {sprintf($$,"SQRT(%s)",$2);} 1421 | TOK_REAL '(' minmaxlist ')' 1297 1422 {sprintf($$,"REAL(%s)",$3);} 1298 1423 | TOK_INT '(' expr ')' … … 1322 1447 | TOK_ATAN '(' expr ')' 1323 1448 {sprintf($$,"ATAN(%s)",$3);} 1324 | TOK_ABS '('expr ')'1325 {sprintf($$,"ABS(%s)",$ 3);}1449 | TOK_ABS expr ')' 1450 {sprintf($$,"ABS(%s)",$2);} 1326 1451 | TOK_MOD '(' minmaxlist ')' 1327 1452 {sprintf($$,"MOD(%s)",$3);} … … 1391 1516 {sprintf($$,"%s",$2);} 1392 1517 1393 after_slash : expr 1518 after_slash : {strcpy($$,"");} 1519 | expr 1394 1520 {sprintf($$,"/%s",$1);} 1395 1521 | '=' expr %prec TOK_EQ 1396 {sprintf($$," == %s",$2);}1522 {sprintf($$,"/= %s",$2);} 1397 1523 | TOK_SLASH expr 1398 1524 {sprintf($$,"//%s",$2);} … … 1414 1540 if (!strcasecmp(identcopy,"Agrif_Parent") ) 1415 1541 agrif_parentcall =1; 1416 if ( A GRIF_n_Agrif_in_Tok_NAME(identcopy) == 1 )1542 if ( Agrif_in_Tok_NAME(identcopy) == 1 ) 1417 1543 { 1418 1544 inagrifcallargument = 1; 1419 A GRIF_n_AddsubroutineTolistsubwhereagrifused();1545 AddsubroutineTolistsubwhereagrifused(); 1420 1546 } 1421 1547 } … … 1436 1562 { 1437 1563 sprintf($$," %s ( %s )",$1,$3); 1438 AGRIF_0_ModifyTheAgrifFunction($3);1564 ModifyTheAgrifFunction_0($3); 1439 1565 agrif_parentcall =0; 1440 1566 } … … 1472 1598 ; 1473 1599 ident : TOK_NAME { 1474 strcpy(identcopy,$1); 1475 pointedvar=0; 1476 if ( VarIsNonGridDepend($1) == 0 && 1477 formatdeclare == 0 1478 ) 1600 if ( VariableIsNotFunction($1) == 0 ) 1479 1601 { 1480 if ( inagrifcallargument == 1 || 1481 OPTI_0_varisallocatable($1) == 1 || 1482 OPTI_0_varispointer($1) == 1 ) 1602 if ( inagrifcallargument == 1 ) 1483 1603 { 1484 AGRIF_0_ModifyTheVariableName($1); 1604 if ( !strcasecmp($1,identcopy) ) 1605 { 1606 strcpy(sameagrifname,identcopy); 1607 sameagrifargument = 1; 1608 } 1485 1609 } 1486 if ( inagrifcallargument != 1 ) 1487 OPTI_1_ajoutevarindoloop($1); 1610 strcpy(identcopy,$1); 1611 pointedvar=0; 1612 if ( VarIsNonGridDepend($1) == 0 && 1613 formatdeclare == 0 1614 ) 1615 { 1616 if ( inagrifcallargument == 1 || 1617 varisallocatable_0($1) == 1 || 1618 varispointer_0($1) == 1 ) 1619 { 1620 ModifyTheVariableName_0($1); 1621 } 1622 if ( inagrifcallargument != 1 || sameagrifargument ==1 ) 1623 ajoutevarindoloop_1($1); 1624 } 1625 NotifyAgrifFunction_0($1); 1488 1626 } 1489 AGRIF_0_NotifyAgrifFunction($1); 1490 } 1627 } 1491 1628 ; 1492 1629 simple_const: TOK_TRUE … … 1528 1665 } 1529 1666 ; 1530 before_initial : { if ( firstpass == 0 )pos_curinit = setposcur();}1667 before_initial : {pos_curinit = setposcur();} 1531 1668 ; 1532 1669 complex_const: '(' uexpr ',' uexpr ')' … … 1538 1675 if (insubroutinedeclare == 1) 1539 1676 { 1540 OPTI_0_copyuse($2); 1541 } 1542 if (firstpass == 1 ) 1543 { 1544 sprintf(charusemodule,"%s",$2); 1545 Addmoduletothelist($2); 1546 } 1547 if ( firstpass == 0 && inmoduledeclare == 0 ) 1677 copyuse_0($2); 1678 } 1679 sprintf(charusemodule,"%s",$2); 1680 Addmoduletothelist_1($2); 1681 1682 if ( inmoduledeclare == 0 ) 1548 1683 { 1549 1684 pos_end = setposcur(); 1550 RemoveWordSET (fortranout,pos_curuse,1685 RemoveWordSET_0(fortranout,pos_curuse, 1551 1686 pos_end-pos_curuse); 1552 1687 } … … 1556 1691 if (insubroutinedeclare == 1) 1557 1692 { 1558 OPTI_1_completelistvarpointtovar($2,$4);1693 completelistvarpointtovar_1($2,$4); 1559 1694 } 1560 1695 if ( firstpass == 1 ) … … 1574 1709 sprintf(charusemodule,"%s",$2); 1575 1710 } 1576 Addmoduletothelist ($2);1577 } 1578 if ( firstpass == 0 &&inmoduledeclare == 0 )1711 Addmoduletothelist_1($2); 1712 } 1713 if ( inmoduledeclare == 0 ) 1579 1714 { 1580 1715 pos_end = setposcur(); 1581 RemoveWordSET (fortranout,pos_curuse,1716 RemoveWordSET_0(fortranout,pos_curuse, 1582 1717 pos_end-pos_curuse); 1583 1718 } … … 1588 1723 if (insubroutinedeclare == 1) 1589 1724 { 1590 OPTI_0_copyuseonly($2); 1591 } 1592 if (firstpass == 1 ) 1593 { 1594 sprintf(charusemodule,"%s",$2); 1595 Addmoduletothelist($2); 1596 } 1597 if ( firstpass == 0 && inmoduledeclare == 0 ) 1725 copyuseonly_0($2); 1726 } 1727 sprintf(charusemodule,"%s",$2); 1728 Addmoduletothelist_1($2); 1729 1730 if ( inmoduledeclare == 0 ) 1598 1731 { 1599 1732 pos_end = setposcur(); 1600 RemoveWordSET (fortranout,pos_curuse,1733 RemoveWordSET_0(fortranout,pos_curuse, 1601 1734 pos_end-pos_curuse); 1602 1735 } … … 1607 1740 if (insubroutinedeclare == 1) 1608 1741 { 1609 OPTI_1_completelistvarpointtovar($2,$6);1742 completelistvarpointtovar_1($2,$6); 1610 1743 } 1611 1744 if ( firstpass == 1 ) … … 1626 1759 sprintf(charusemodule,"%s",$2); 1627 1760 } 1628 Addmoduletothelist ($2);1761 Addmoduletothelist_1($2); 1629 1762 } 1630 if ( firstpass == 0 && inmoduledeclare == 0 ) 1631 { 1632 pos_end = setposcur(); 1633 RemoveWordSET(fortranout,pos_curuse, 1634 pos_end-pos_curuse); 1763 if ( firstpass == 0 ) 1764 { 1765 if ( inmoduledeclare == 0 ) 1766 { 1767 pos_end = setposcur(); 1768 RemoveWordSET_0(fortranout,pos_curuse, 1769 pos_end-pos_curuse); 1770 } 1771 else 1772 { 1773 /* if we are in the module declare and if the */ 1774 /* onlylist is a list of global variable */ 1775 variableisglobalinmodule($6, $2, fortranout); 1776 } 1635 1777 } 1636 1778 } … … 1638 1780 word_use : TOK_USE 1639 1781 { 1640 if ( firstpass == 0 ) pos_curuse = setposcur()-3;1782 pos_curuse = setposcur()-strlen($1); 1641 1783 } 1642 1784 ; … … 1683 1825 $$ = coupletmp; 1684 1826 pointedvar=1; 1685 OPTI_1_ajoutevarindoloop($1);1827 ajoutevarindoloop_1($1); 1686 1828 } 1687 1829 | TOK_NAME { … … 1709 1851 tmpdeclaration_everdone = 0; 1710 1852 /* */ 1711 OPTI_0_closeandcallsubloopandincludeit(1,$1,"");1712 /* at the end of the firstpas swe should remove */1853 closeandcallsubloopandincludeit_0(1,$1,""); 1854 /* at the end of the firstpas we should remove */ 1713 1855 /* from the listvarindoloop all variables */ 1714 1856 /* which has not been declared as table in the */ 1715 1857 /* globliste */ 1716 OPTI_1_cleanlistvarfordoloop(1);1858 cleanlistvarfordoloop_1(1); 1717 1859 } 1718 1860 else … … 1723 1865 if ( aftercontainsdeclare == 0 ) 1724 1866 { 1725 if ( firstpass == 1) 1726 DATA_1_CompleteGlobListeWithDatalist(); 1727 addi_0_addsubroutine_inst_back_alloc(1); 1867 CompleteGlobListeWithDatalist_1(); 1868 addsubroutine_alloc_0(1); 1728 1869 } 1729 1870 } … … 1739 1880 insubroutinedeclare = 0; 1740 1881 /* */ 1741 OPTI_0_closeandcallsubloopandincludeit(2,$1,"");1882 closeandcallsubloopandincludeit_0(2,$1,""); 1742 1883 /* it is like end subroutine or end program */ 1743 1884 /* Common case */ 1744 /* at the end of the firstpas swe should remove */1885 /* at the end of the firstpas we should remove */ 1745 1886 /* from the listvarindoloop all variables which */ 1746 1887 /* has not been declared as table in the */ 1747 1888 /* globliste */ 1748 OPTI_1_cleanlistvarfordoloop(1);1889 cleanlistvarfordoloop_1(1); 1749 1890 } 1750 1891 } … … 1755 1896 insubroutinedeclare = 0; 1756 1897 /* */ 1757 OPTI_0_closeandcallsubloopandincludeit(3,$1,$2);1898 closeandcallsubloopandincludeit_0(3,$1,$2); 1758 1899 /* Common case */ 1759 /* at the end of the firstpas swe should remove from */1900 /* at the end of the firstpas we should remove from */ 1760 1901 /* the listvarindoloop all variables which has not */ 1761 1902 /* been declared as table in the globliste */ 1762 OPTI_1_cleanlistvarfordoloop(3);1903 cleanlistvarfordoloop_1(3); 1763 1904 } 1764 1905 | TOK_ENDSUBROUTINE opt_name … … 1768 1909 insubroutinedeclare = 0; 1769 1910 /* */ 1770 OPTI_0_closeandcallsubloopandincludeit(1,$1,$2);1911 closeandcallsubloopandincludeit_0(1,$1,$2); 1771 1912 /* Common case */ 1772 /* at the end of the firstpas swe should remove from */1913 /* at the end of the firstpas we should remove from */ 1773 1914 /* the listvarindoloop all variables which has not */ 1774 1915 /* been declared as table in the globliste */ 1775 OPTI_1_cleanlistvarfordoloop(1);1916 cleanlistvarfordoloop_1(1); 1776 1917 } 1777 1918 | TOK_ENDFUNCTION opt_name … … 1781 1922 insubroutinedeclare = 0; 1782 1923 /* */ 1783 OPTI_0_closeandcallsubloopandincludeit(0,$1,$2);1924 closeandcallsubloopandincludeit_0(0,$1,$2); 1784 1925 /* Common case */ 1785 /* at the end of the firstpas swe should remove from */1926 /* at the end of the firstpas we should remove from */ 1786 1927 /* the listvarindoloop all variables which has not */ 1787 1928 /* been declared as table in the globliste */ 1788 OPTI_1_cleanlistvarfordoloop(0);1929 cleanlistvarfordoloop_1(0); 1789 1930 } 1790 1931 | TOK_ENDMODULE opt_name … … 1795 1936 if ( aftercontainsdeclare == 0 ) 1796 1937 { 1797 if ( firstpass == 1) 1798 DATA_1_CompleteGlobListeWithDatalist(); 1799 addi_0_addsubroutine_inst_back_alloc(1); 1938 CompleteGlobListeWithDatalist_1(); 1939 addsubroutine_alloc_0(1); 1800 1940 } 1801 1941 } … … 1820 1960 if (inmoduledeclare == 1 ) 1821 1961 { 1822 if ( firstpass == 1) 1823 DATA_1_CompleteGlobListeWithDatalist(); 1824 addi_0_addsubroutine_inst_back_alloc(0); 1962 CompleteGlobListeWithDatalist_1(); 1963 addsubroutine_alloc_0(0); 1825 1964 } 1826 1965 inmoduledeclare = 0 ; … … 1833 1972 | caselist ':' expr 1834 1973 ; 1835 boucledo : worddo do_var '=' expr ',' expr1836 | worddo do_var '=' expr ',' expr ',' expr1974 boucledo : worddo opt_int do_var '=' expr ',' expr 1975 | worddo opt_int do_var '=' expr ',' expr ',' expr 1837 1976 | wordwhile expr 1838 1977 | TOK_ENDDO optname 1978 ; 1979 opt_int : 1980 | TOK_CSTINT 1839 1981 ; 1840 1982 opt_name : '\n' {strcpy($$,"");} … … 1854 1996 1855 1997 iffable: TOK_CONTINUE 1856 | ident dims dims after_ident_dims 1857 | structure_component after_ident_dims 1998 | ident_dims after_ident_dims 1858 1999 | goto 1859 2000 | io 1860 2001 | call 1861 | TOK_EXIT opt_name 1862 | TOK_RETURN optexpr 2002 | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')' 2003 | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' 2004 | TOK_EXIT optexpr 2005 | TOK_RETURN opt_expr 2006 | TOK_CYCLE opt_expr 1863 2007 | stop opt_expr 2008 | int_list 2009 ; 2010 before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;} 2011 ident_dims : ident before_dims dims dims 2012 {created_dimensionlist = 1;} 2013 | ident_dims '%' ident before_dims dims dims 2014 {created_dimensionlist = 1;} 2015 int_list : TOK_CSTINT 2016 | int_list ',' TOK_CSTINT 1864 2017 ; 1865 2018 after_ident_dims : '=' expr 1866 {sprintf($$,"=%s",$2);}1867 2019 | TOK_POINT_TO expr 1868 {sprintf($$,"=>%s",$2);}1869 2020 ; 1870 2021 call: keywordcall opt_call … … 1873 2024 incalldeclare=0; 1874 2025 if ( oldfortranout && 1875 !strc mp(meetagrifinitgrids,subroutinename) &&2026 !strcasecmp(meetagrifinitgrids,subroutinename) && 1876 2027 firstpass == 0 && 1877 2028 callmpiinit == 1) 1878 2029 { 1879 2030 pos_end = setposcur(); 1880 RemoveWordSET (fortranout,pos_curcall,2031 RemoveWordSET_0(fortranout,pos_curcall, 1881 2032 pos_end-pos_curcall); 1882 2033 fprintf(oldfortranout," Call MPI_Init (%s) \n" … … 1888 2039 { 1889 2040 pos_end = setposcur(); 1890 RemoveWordSET (fortranout,pos_curcall,2041 RemoveWordSET_0(fortranout,pos_curcall, 1891 2042 pos_end-pos_curcall); 1892 2043 fprintf(oldfortranout, … … 1894 2045 strcpy(subofagrifinitgrids,subroutinename); 1895 2046 } 2047 Instanciation_0(sameagrifname); 1896 2048 } 1897 2049 ; … … 1919 2071 } 1920 2072 else callagrifinitgrids = 0; 1921 if ( AGRIF_n_Vartonumber($2) == 1 )2073 if ( Vartonumber($2) == 1 ) 1922 2074 { 1923 2075 incalldeclare=1; 1924 2076 inagrifcallargument = 1 ; 1925 A GRIF_n_AddsubroutineTolistsubwhereagrifused();2077 AddsubroutineTolistsubwhereagrifused(); 1926 2078 } 1927 2079 } 1928 2080 ; 1929 2081 before_call : TOK_CALL 1930 { if ( firstpass == 0 )pos_curcall=setposcur()-4;}2082 {pos_curcall=setposcur()-4;} 1931 2083 callarglist: callarg 1932 2084 | callarglist ',' callarg … … 1955 2107 io: iofctl ioctl 1956 2108 | read option_read 1957 | write '(' idfile opt_ioctl_format ')' opt_outlist1958 {formatdeclare = 0;}1959 2109 | TOK_REWIND after_rewind 1960 2110 | print option_print … … 1964 2114 wordformat : TOK_FORMAT 1965 2115 {formatdeclare = 1;} 2116 opt_ioctlformat : 2117 | ioctl_format 2118 ; 1966 2119 opt_ioctl_format : 1967 2120 | ',' ioctl_format … … 1974 2127 | ioctl_format ',' format_expr 1975 2128 ; 1976 format_expr : uexpr 2129 format_expr : 2130 | uexpr 1977 2131 | TOK_CSTINT TOK_CHAR_INT 1978 2132 | TOK_CSTINT debut_format ioctl_format fin_format 1979 2133 | TOK_SLASH opt_CHAR_INT 2134 | TOK_CHAR_INT TOK_SLASH format_expr 2135 | TOK_SLASH TOK_SLASH 1980 2136 | TOK_CHAR_INT 2137 | '(' format_expr ')' 2138 | '(' uexpr ')' 1981 2139 ; 1982 2140 opt_CHAR_INT : … … 2018 2176 | TOK_DASTER 2019 2177 | TOK_NAME expr 2178 | TOK_NAME expr '%' ident_dims 2020 2179 | TOK_NAME '(' triplet ')' 2021 2180 | TOK_NAME '*' 2022 2181 | TOK_NAME TOK_DASTER 2023 /* | TOK_REC '=' ident*/ 2024 ; 2025 iofctl: ctlkwd 2026 ; 2027 ctlkwd: TOK_INQUIRE 2028 | TOK_OPEN 2182 ; 2183 iofctl: TOK_OPEN 2029 2184 | TOK_CLOSE 2030 2185 ; … … 2034 2189 2035 2190 read:TOK_READ 2036 ;2037 write:TOK_WRITE2038 ; 2039 print: TOK_PRINT fexpr2191 | TOK_INQUIRE 2192 | TOK_WRITE 2193 ; 2194 print: TOK_PRINT fexpr 2040 2195 | TOK_PRINT '*' 2041 2196 ; … … 2061 2216 | inlist ',' inelt 2062 2217 ; 2063 inelt: lhs 2218 opt_lhs : 2219 | lhs 2220 ; 2221 inelt: opt_lhs opt_operation 2222 | '(' inlist ')' opt_operation 2223 | predefinedfunction opt_operation 2224 | simple_const opt_operation 2064 2225 | '(' inlist ',' dospec ')' 2065 2226 ; 2227 opt_operation : 2228 | operation 2229 | opt_operation operation 2230 ; 2066 2231 outlist: other {strcpy($$,$1);} 2067 2232 | out2 {strcpy($$,$1);} … … 2107 2272 ; 2108 2273 allocation_list: allocate_object 2274 | ident_dims 2109 2275 | allocation_list ',' allocate_object 2110 2276 ; 2111 2277 allocate_object: ident 2112 { OPTI_1_AddIdentToTheAllocateList($1);}2278 {AddIdentToTheAllocateList_1($1);} 2113 2279 | structure_component 2114 2280 | array_element 2115 2281 ; 2116 2282 array_element: ident '(' funargs ')' 2117 { OPTI_1_AddIdentToTheAllocateList($1);}2283 {AddIdentToTheAllocateList_1($1);} 2118 2284 ; 2119 2285 subscript_list: expr … … 2136 2302 | TOK_CONSTRUCTID ':' 2137 2303 ; 2138 logif: TOK_LOGICALIF '('expr ')'2304 logif: TOK_LOGICALIF expr ')' 2139 2305 ; 2140 2306 do_var: ident {strcpy($$,$1);} … … 2196 2362 } 2197 2363 } 2198 strcpy(commonfile,fichier_entree);2199 2364 2200 2365 /******************************************************************************/ … … 2217 2382 strcpy(NamePrecision," "); 2218 2383 VariableIsParameter = 0 ; 2219 PrecisionGiven = 0 ; 2220 lengspecgiven =0; 2384 strcpy(NamePrecision,""); 2221 2385 c_star = 0 ; 2222 2386 insubroutinedeclare = 0 ; 2223 2387 strcpy(subroutinename," "); 2224 CharacterSizeGiven = 0 ;2225 2388 InitialValueGiven = 0 ; 2226 2389 strcpy(EmptyChar," "); … … 2236 2399 /* 2- Parsing of the input file (1 time) */ 2237 2400 /******************************************************************************/ 2238 if (firstpass == 0 ) fortranout=fopen(nomfileoutput,"w"); 2239 /* we should add the new module comes from common block */ 2240 if (firstpass == 0 && fortran77 == 1 ) fprintf 2401 if (firstpass == 0 ) 2402 { 2403 fortranout=fopen(nomfileoutput,"w"); 2404 /* we should add the new module comes from common block */ 2405 if (fortran77 == 1 ) fprintf 2241 2406 (fortranout,"#include \"NewModule_%s.h\" \n",curfilename); 2407 } 2242 2408 2243 2409 fortranparse(); … … 2245 2411 strcpy(curfile,mainfile); 2246 2412 2247 if (firstpass == 0) fclose(fortranout);2413 if (firstpass == 0 ) fclose(fortranout); 2248 2414 }
Note: See TracChangeset
for help on using the changeset viewer.
