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

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

Ignore:
Timestamp:
2008-09-24T15:05:20+02:00 (16 years ago)
Author:
rblod
Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/LIB/fortran.y

    r774 r1200  
    4343char c_selectorname[LONG_C]; 
    4444char ligne[LONG_C]; 
     45char truename[LONGNOM]; 
    4546char identcopy[LONG_C]; 
    4647int c_selectorgiven=0; 
    … …  
    6162       listnom  *ln; 
    6263       listcouple  *lc; 
     64       listname *lnn; 
    6365       typedim   dim1; 
    6466       variable *v; 
    … …  
    6971%right '=' 
    7072%left TOK_BINARY_OP 
    71 %left EQV NEQV 
     73%left TOK_EQV TOK_NEQV 
    7274%left TOK_OR TOK_XOR 
    7375%left TOK_AND 
    … …  
    8183 
    8284%token TOK_SEP 
     85%token TOK_SEMICOLON 
    8386%token TOK_NEXTLINE 
    8487%token TOK_PARAMETER 
    … …  
    110113%token TOK_EXIST 
    111114%token TOK_MIN 
    112 %token TOK_INT 
    113115%token TOK_FLOAT 
    114116%token TOK_EXP 
    … …  
    199201%token <nac> TOK_DASTER 
    200202%token <nac> TOK_EQ 
     203%token <nac> TOK_EQV 
    201204%token <nac> TOK_GT 
    202205%token <nac> TOK_LT 
    203206%token <nac> TOK_GE 
    204207%token <nac> TOK_NE 
     208%token <nac> TOK_NEQV 
    205209%token <nac> TOK_LE 
    206210%token <nac> TOK_OR 
    … …  
    248252%token <nac> TOK_FILENAME 
    249253%token ',' 
    250 %token ';' 
    251254%token ':' 
    252255%token '(' 
    … …  
    291294%type <nac> opt_signe 
    292295%type <nac> filename 
     296%type <na> attribute 
    293297%type <na> complex_const 
    294298%type <na> begin_array 
    … …  
    322326%type <na> operation 
    323327%type <na> proper_lengspec 
     328%type <lnn> use_name_list 
     329%type <lnn> public 
    324330 
    325331%left TOK_OP 
    … …  
    336342      ; 
    337343suite_line_list : suite_line 
    338       |   suite_line ';' suite_line_list 
    339       ; 
    340 suite_line : entry fin_line/* subroutine, function, module                    */ 
     344      |   suite_line_list TOK_SEMICOLON suite_line 
     345      ; 
     346suite_line : entry fin_line  /* subroutine, function, module                    */ 
    341347      | spec fin_line      /* declaration                                     */ 
    342348      | before_include filename fin_line 
    … …  
    561567                      if ( firstpass == 1  && couldaddvariable == 1) 
    562568                      { 
     569                         strcpy(nameinttypenameback,nameinttypename); 
     570                         strcpy(nameinttypename,""); 
    563571                         curvar=createvar($1,NULL); 
     572                        strcpy(nameinttypename,nameinttypenameback); 
    564573                         curlistvar=insertvar(NULL,curvar); 
    565574                         $$=settype("",curlistvar); 
    … …  
    570579                      if ( firstpass == 1  && couldaddvariable == 1) 
    571580                      { 
     581                         strcpy(nameinttypenameback,nameinttypename); 
     582                         strcpy(nameinttypename,"");                       
    572583                         curvar=createvar($3,NULL); 
     584                         strcpy(nameinttypename,nameinttypenameback);                          
    573585                         $$=insertvar($1,curvar); 
    574586                      } 
    … …  
    609621                         else Add_Parameter_Var_1($3); 
    610622                         pos_end = setposcur(); 
    611                          RemoveWordSET_0(fortranout,pos_cur_decl, 
     623                        RemoveWordSET_0(fortranout,pos_cur_decl, 
    612624                                                    pos_end-pos_cur_decl); 
    613625                      } 
    … …  
    672684                   } 
    673685      | public 
     686      { 
     687      if (firstpass == 0) 
     688      { 
     689      if ($1) 
     690      { 
     691      removeglobfromlist(&($1)); 
     692      pos_end = setposcur(); 
     693           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur); 
     694      writelistpublic($1); 
     695      } 
     696      } 
     697      } 
    674698      | private 
    675699      | use_stat 
    … …  
    752776                      { 
    753777                      pos_end = setposcur(); 
    754                       RemoveWordSET_0(fortranout,pos_cur_decl, 
     778                      /*if (insubroutinedeclare == 0) 
     779                        {   */ 
     780                         RemoveWordSET_0(fortranout,pos_cur_decl, 
    755781                                                 pos_end-pos_cur_decl); 
     782                                          
     783                       /* } 
     784                      else 
     785                       {*/ 
     786                        ReWriteDeclarationAndAddTosubroutine_01($1); 
     787                        pos_cur_decl = setposcur(); 
     788                         
     789                       /*}*/ 
    756790                      if ( firstpass == 0 && 
    757791                           GlobalDeclaration == 0 && 
    … …  
    769803                         $$ = $1; 
    770804                         Add_Globliste_1($1); 
     805                                                   
    771806                         if ( insubroutinedeclare == 0 ) 
    772807                                                  Add_GlobalParameter_Var_1($1); 
    … …  
    780815                         /* if variables has been declared in a subroutine    */ 
    781816                         if ( insubroutinedeclare == 1 ) 
    782                          { 
    783                            Add_SubroutineDeclaration_Var_1($1); 
     817                         {  
     818                       /*    Add_SubroutineDeclaration_Var_1($1);*/ 
    784819                         } 
    785820                         /* If there are a SAVE declarations in module's      */ 
    … …  
    845880                         writeheadnewsub_0(2); 
    846881                      } 
     882                      strcpy(nameinttypename,""); 
     883 
    847884                   } 
    848885      ; 
    … …  
    9981035      ; 
    9991036public : TOK_PUBLIC '\n' 
     1037        { 
     1038        $$=(listname *)NULL; 
     1039        } 
    10001040      | TOK_PUBLIC opt_sep use_name_list 
     1041         { 
     1042          $$=$3; 
     1043         } 
    10011044      ; 
    10021045use_name_list : TOK_NAME 
     1046           { 
     1047           $$ = Insertname(NULL,$1); 
     1048           } 
    10031049      | use_name_list ',' TOK_NAME 
     1050          { 
     1051          $$ = Insertname($1,$3); 
     1052          } 
    10041053      ; 
    10051054common : before_common var_common_list 
    … …  
    12221271before_typepar : TOK_TYPEPAR 
    12231272                   { 
    1224                       if ( couldaddvariable == 1 ) VarTypepar = 1 ; 
     1273                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ; 
    12251274                      couldaddvariable = 0 ; 
    1226                       pos_cur_decl = setposcur()-5; 
     1275                      pos_cur_decl = setposcur()-5;*/ 
     1276                   pos_cur_decl = setposcur()-5; 
    12271277                   } 
    12281278      ; 
    … …  
    14251475      | TOK_REAL '(' minmaxlist ')' 
    14261476                   {sprintf($$,"REAL(%s)",$3);} 
    1427       | TOK_INT '(' expr ')' 
    1428                    {sprintf($$,"INT(%s)",$3);} 
    14291477      | TOK_NINT '(' expr ')' 
    14301478                   {sprintf($$,"NINT(%s)",$3);} 
    … …  
    14921540      |  TOK_EQ expr %prec TOK_EQ 
    14931541                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 
     1542      |  TOK_EQV expr %prec TOK_EQV 
     1543                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                    
    14941544      |  TOK_GT expr %prec TOK_EQ 
    14951545                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 
    … …  
    15101560      |  TOK_NE expr %prec TOK_EQ 
    15111561                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 
     1562      |  TOK_NEQV expr %prec TOK_EQV 
     1563                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                    
    15121564      |  TOK_XOR expr 
    15131565                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 
    … …  
    16311683                          strcpy(identcopy,$1); 
    16321684                          pointedvar=0; 
     1685                          strcpy(truename,$1); 
     1686                          if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1)); 
     1687/* 
    16331688                          if ( VarIsNonGridDepend($1) == 0 && 
    16341689                               Variableshouldberemove($1) == 0 ) 
    … …  
    16381693                                  varispointer_0($1) == 1 ) 
    16391694                             { 
    1640                                 ModifyTheVariableName_0($1); 
     1695                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1)) 
     1696                             { 
     1697                              if (varistyped_0($1) == 0) 
     1698                                 { 
     1699                                 ModifyTheVariableName_0($1); 
     1700                                 } 
     1701                                 } 
     1702                                 else 
     1703                                 { 
     1704                                 } 
     1705                             } 
     1706                             if (variscoupled_0($1) == 1) 
     1707                             { 
     1708      printf("mla variable %s est couplee %s\n",$1,getcoupledname_0($1)); 
     1709                             ModifyTheVariableNamecoupled_0($1,getcoupledname_0($1)); 
    16411710                             } 
    16421711                             if ( inagrifcallargument != 1 || 
    … …  
    16451714                          } 
    16461715                          NotifyAgrifFunction_0($1); 
     1716*/ 
     1717                          if ( VarIsNonGridDepend(truename) == 0 && 
     1718                               Variableshouldberemove(truename) == 0 ) 
     1719                          { 
     1720                             if ( inagrifcallargument == 1 || 
     1721                                  varisallocatable_0(truename) == 1 || 
     1722                                  varispointer_0(truename) == 1 ) 
     1723                             { 
     1724                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1)) 
     1725                             { 
     1726                              if (varistyped_0(truename) == 0) 
     1727                                 { 
     1728                                 ModifyTheVariableName_0(truename,strlen($1)); 
     1729                                 } 
     1730                                 } 
     1731                             } 
     1732                             if ( inagrifcallargument != 1 || 
     1733                                  sameagrifargument ==1 ) 
     1734                                  Add_UsedInSubroutine_Var_1(truename); 
     1735                          } 
     1736                          NotifyAgrifFunction_0(truename); 
    16471737                       } 
    16481738                       } 
    … …  
    18011891                          if ( inmoduledeclare == 0 ) 
    18021892                          { 
    1803                              pos_end = setposcur(); 
     1893 
     1894                            pos_end = setposcur(); 
    18041895                             RemoveWordSET_0(fortranout,pos_curuse, 
    18051896                                                   pos_end-pos_curuse); 
     1897                       if (oldfortranout)  
     1898                         variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold); 
     1899                         
    18061900                          } 
    18071901                          else 
    18081902                          { 
     1903 
    18091904                             /* if we are in the module declare and if the    */ 
    18101905                             /* onlylist is a list of global variable         */ 
    1811                              variableisglobalinmodule($6, $2, fortranout); 
     1906                             variableisglobalinmodule($6, $2, fortranout,pos_curuse); 
    18121907                          } 
    18131908                       } 
    … …  
    18181913                   { 
    18191914                      pos_curuse = setposcur()-strlen($1); 
     1915                     if (firstpass == 0 && oldfortranout) { 
     1916                     pos_curuseold = setposcurname(oldfortranout); 
     1917                     } 
    18201918                   } 
    18211919      ; 
    … …  
    18881986                         Add_SubroutineWhereAgrifUsed_1(subroutinename, 
    18891987                                                        curmodulename); 
     1988                                                        inallocate = 0; 
    18901989                     } 
    18911990      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' 
    … …  
    18931992                          Add_SubroutineWhereAgrifUsed_1(subroutinename, 
    18941993                                                         curmodulename); 
     1994                                                         inallocate = 0; 
    18951995                     } 
    18961996      | TOK_NULLIFY '(' pointer_name_list ')' 
    … …  
    19322032                          insubroutinedeclare = 0; 
    19332033                          /*                                                  */ 
    1934                           pos_cur = setposcur(); 
     2034                          pos_cur = setposcur();                         
    19352035                          closeandcallsubloopandincludeit_0(2); 
    19362036                            functiondeclarationisdone = 0; 
    … …  
    19512051                       insubroutinedeclare = 0; 
    19522052                       /*                                                     */ 
    1953                        pos_cur = setposcur(); 
     2053                       pos_cur = setposcur();                       
    19542054                       closeandcallsubloopandincludeit_0(3); 
    19552055                            functiondeclarationisdone = 0; 
    … …  
    19712071                       /*                                                     */ 
    19722072                       pos_cur = setposcur(); 
     2073                                              
    19732074                       closeandcallsubloopandincludeit_0(1); 
    19742075                            functiondeclarationisdone = 0; 
    … …  
    19892090                       /*                                                     */ 
    19902091                       pos_cur = setposcur(); 
     2092 
    19912093                       closeandcallsubloopandincludeit_0(0); 
    19922094                            functiondeclarationisdone = 0; 
    … …  
    20052107                       { 
    20062108                       /* if we never meet the contains keyword               */ 
    2007                       Remove_Word_end_module_0(); 
     2109                      Remove_Word_end_module_0(strlen($2)); 
    20082110                       if ( inmoduledeclare == 1 ) 
    20092111                       { 
    … …  
    20122114                             Write_GlobalParameter_Declaration_0(); 
    20132115                             Write_NotGridDepend_Declaration_0(); 
     2116                             Write_GlobalType_Declaration_0(); 
    20142117                             Write_Alloc_Subroutine_For_End_0(); 
    20152118                          } 
    20162119                       } 
     2120                                            
    20172121                       inmoduledeclare = 0 ; 
    20182122                       inmodulemeet = 0 ; 
    … …  
    20502154                         Remove_Word_Contains_0(); 
    20512155                         Write_GlobalParameter_Declaration_0(); 
     2156                         Write_GlobalType_Declaration_0(); 
    20522157                         Write_NotGridDepend_Declaration_0(); 
    20532158                         Write_Alloc_Subroutine_0(); 
    … …  
    20642169                          insubroutinedeclare = 0; 
    20652170                          /*                                                  */ 
     2171 
    20662172                          closeandcallsubloop_contains_0(); 
    20672173                            functiondeclarationisdone = 0; 
    … …  
    21522258                          Add_SubroutineWhereAgrifUsed_1(subroutinename, 
    21532259                                                        curmodulename); 
     2260                                                        inallocate = 0; 
    21542261                     } 
    21552262      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' 
    … …  
    21572264                          Add_SubroutineWhereAgrifUsed_1(subroutinename, 
    21582265                                                        curmodulename); 
     2266                                                        inallocate = 0; 
    21592267                     } 
    21602268      | TOK_EXIT optexpr 
    … …  
    21922300                           callmpiinit == 1) 
    21932301                      { 
    2194                          pos_end = setposcur(); 
     2302                      /*   pos_end = setposcur(); 
    21952303                         RemoveWordSET_0(fortranout,pos_curcall, 
    21962304                                               pos_end-pos_curcall); 
    21972305                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n" 
    2198                                                                    ,mpiinitvar); 
     2306                                                                   ,mpiinitvar);*/ 
    21992307                      } 
    22002308                      if ( oldfortranout           && 
    … …  
    22762384io : iofctl ioctl 
    22772385      | read option_read 
     2386      | write ioctl 
     2387      | write ioctl outlist 
    22782388      | TOK_REWIND after_rewind 
    22792389      | TOK_FORMAT 
    … …  
    23312441read :TOK_READ 
    23322442      | TOK_INQUIRE 
    2333       | TOK_WRITE 
    23342443      | TOK_PRINT 
    23352444      ; 
     2445 
     2446write : TOK_WRITE 
     2447      ; 
     2448 
    23362449fexpr : unpar_fexpr 
    23372450      | '(' fexpr ')' 
    … …  
    23702483      | opt_operation operation 
    23712484      ; 
    2372 outlist : other      {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
     2485outlist : uexpr    {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
     2486      | other      {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
    23732487      | out2       {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
    23742488      ; 
    … …  
    25382652   couldaddvariable=1; 
    25392653   aftercontainsdeclare = 1; 
     2654   strcpy(nameinttypename,""); 
    25402655   /* Name of the file without format                                         */ 
    25412656   tmp = strchr(fichier_entree, '.'); 
Note: See TracChangeset for help on using the changeset viewer.