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 2673 for branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y – NEMO

Ignore:
Timestamp:
2011-03-08T17:44:21+01:00 (13 years ago)
Author:
rblod
Message:

Update Agrif LIB on dev_r2586_dynamic_mem

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y

    r2528 r2673  
    3333/* version 1.7                                                                */ 
    3434/******************************************************************************/ 
     35 
    3536%{ 
     37#define YYMAXDEPTH 1000 
    3638#include <stdlib.h> 
    3739#include <stdio.h> 
    … …  
    318320%type <na> opt_expr 
    319321%type <na> optexpr 
    320 %type <na> datavallist 
     322%type <lnn> datavallist 
     323%type <lnn> datanamelist 
    321324%type <na> after_slash 
    322325%type <na> after_equal 
    … …  
    392395      ; 
    393396opt_recursive : 
     397      {isrecursive = 0;} 
    394398      | TOK_RECURSIVE 
     399      {isrecursive = 1;} 
    395400      ; 
    396401entry : 
    397402      | opt_recursive TOK_SUBROUTINE name_routine arglist 
    398403                   { 
    399                       if ( couldaddvariable == 1 ) 
     404                      if ( couldaddvariable == 1) 
    400405                      { 
    401406                      /* open param file                                      */ 
    … …  
    618623                      { 
    619624                         if ( insubroutinedeclare == 0 ) 
     625                         { 
    620626                                                  Add_GlobalParameter_Var_1($3); 
     627                                                  } 
    621628                         else Add_Parameter_Var_1($3); 
    622629                         pos_end = setposcur(); 
    … …  
    675682                      VariableIsParameter =  0 ; 
    676683                      Allocatabledeclare = 0 ; 
     684                      Targetdeclare = 0 ; 
    677685                      SaveDeclare = 0; 
    678686                      pointerdeclare = 0; 
    … …  
    708716                   { 
    709717                      /* we should remove the data declaration                */ 
    710                       if ( couldaddvariable == 1 && aftercontainsdeclare == 0 ) 
     718                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 ) 
    711719                      { 
    712720                        pos_end = setposcur(); 
    713721                        RemoveWordSET_0(fortranout,pos_curdata, 
    714722                                              pos_end-pos_curdata); 
     723                      } 
     724                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 ) 
     725                      { 
     726                      if (firstpass == 0) 
     727                      { 
     728                        ReWriteDataStatement_0(fortranout); 
     729                        pos_end = setposcur(); 
     730                  } 
    715731                      } 
    716732                  } 
    … …  
    792808                           insubroutinedeclare == 0 ) 
    793809                      { 
     810 
    794811                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n" 
    795812                                                                ,curmodulename); 
    … …  
    800817                         tofich (module_declar, ligne,1); 
    801818                         GlobalDeclaration = 1 ; 
     819                         pos_cur_decl = setposcur(); 
     820 
    802821                      } 
    803822                         $$ = $1; 
    … …  
    839858                      VariableIsParameter =  0 ; 
    840859                      Allocatabledeclare = 0 ; 
     860                      Targetdeclare = 0 ; 
    841861                      SaveDeclare = 0; 
    842862                      pointerdeclare = 0; 
    … …  
    898918                   { 
    899919                      pos_curdata = setposcur()-strlen($1); 
     920                      Init_List_Data_Var(); 
    900921                   } 
    901922data : TOK_NAME TOK_SLASH datavallist TOK_SLASH 
    … …  
    903924                      if ( couldaddvariable == 1 ) 
    904925                      { 
    905                       if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 
    906                       else sprintf(ligne,"(/ %s /)",$3); 
    907                       Add_Data_Var_1($1,ligne); 
     926/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 
     927                      else */ 
     928/*                      sprintf(ligne,"%s",$3);*/ 
     929                      createstringfromlistname(ligne,$3); 
     930                      if (firstpass == 1) 
     931                      Add_Data_Var_1(&List_Data_Var,$1,ligne); 
     932                      else 
     933                      Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne); 
    908934                      } 
    909935                   } 
    … …  
    912938                      if ( couldaddvariable == 1 ) 
    913939                      { 
    914                       if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 
    915                       else sprintf(ligne,"(/ %s /)",$5); 
    916                       Add_Data_Var_1($3,ligne); 
     940                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 
     941                      else */ 
     942                      /*sprintf(ligne,"%s",$5);   */ 
     943                      createstringfromlistname(ligne,$5);                       
     944                      if (firstpass == 1)                       
     945                      Add_Data_Var_1(&List_Data_Var,$3,ligne); 
     946                      else 
     947                      Add_Data_Var_1(&List_Data_Var_Cur,$3,ligne);                       
    917948                      } 
    918949                   } 
    … …  
    926957                       /*******************************************************/ 
    927958                       /*******************************************************/ 
     959                       if (firstpass == 1) 
     960                       Add_Data_Var_Names_01(&List_Data_Var,$1,$3); 
     961                       else 
     962                       Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3); 
    928963                   } 
    929964      ; 
    … …  
    932967                      if ( couldaddvariable == 1 ) 
    933968                      { 
    934                          strcpy($$,$1); 
     969                         $$ = Insertname(NULL,$1,0); 
    935970                      } 
    936971                   } 
    … …  
    939974                      if ( couldaddvariable == 1 ) 
    940975                      { 
    941                          sprintf($$,"%s,%s",$1,$3); 
     976                         $$ = Insertname($3,$1,1); 
    942977                      } 
    943978                   } 
    … …  
    961996      ; 
    962997datanamelist : TOK_NAME 
     998      { 
     999      $$=Insertname(NULL,$1,0); 
     1000      } 
    9631001      | TOK_NAME '(' expr ')' 
     1002      { 
     1003      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n"); 
     1004      exit(0); 
     1005      } 
    9641006      | datanamelist ',' datanamelist 
     1007      { 
     1008      $$ = concat_listname($1,$3); 
     1009      } 
    9651010      ; 
    9661011expr_data : opt_signe simple_const 
    … …  
    9901035      ; 
    9911036interface : TOK_INTERFACE opt_name 
     1037   { 
     1038   ininterfacedeclare = 1 ; 
     1039   printf("INTEFACE entree\n"); 
     1040   } 
    9921041      | TOK_ENDINTERFACE opt_name 
     1042      { 
     1043      ininterfacedeclare = 0; 
     1044      } 
    9931045      ; 
    9941046before_dimension : TOK_DIMENSION 
    … …  
    10451097use_name_list : TOK_NAME 
    10461098           { 
    1047            $$ = Insertname(NULL,$1); 
     1099           $$ = Insertname(NULL,$1,0); 
    10481100           } 
    10491101      | use_name_list ',' TOK_NAME 
    10501102          { 
    1051           $$ = Insertname($1,$3); 
     1103          $$ = Insertname($1,$3,0); 
    10521104          } 
    10531105      ; 
    … …  
    10631115                         { 
    10641116                            sprintf(charusemodule,"%s",$2); 
    1065                             Add_NameOfCommon_1($2); 
     1117                            Add_NameOfCommon_1($2,subroutinename); 
    10661118                            pos_end = setposcur(); 
    10671119                            RemoveWordSET_0(fortranout,pos_curcommon, 
    … …  
    10741126                         { 
    10751127                            sprintf(charusemodule,"%s",$3); 
    1076                             Add_NameOfCommon_1($3); 
     1128                            Add_NameOfCommon_1($3,subroutinename); 
    10771129                            pos_end = setposcur(); 
    10781130                            RemoveWordSET_0(fortranout,pos_curcommon, 
    … …  
    13931445                    } 
    13941446      | TOK_TARGET 
     1447                  {Targetdeclare = 1;} 
    13951448      ; 
    13961449intent_spec : TOK_IN {strcpy($$,$1);} 
    … …  
    15871640      ; 
    15881641 
    1589 lhs : ident         {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
     1642lhs : ident         {if ( couldaddvariable == 1 ) 
     1643                  { 
     1644                  printf("ident = %s\n",$1); 
     1645                  strcpy($$,$1);} 
     1646                  } 
    15901647      | structure_component 
    1591                    {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
     1648                   {if ( couldaddvariable == 1 ) { 
     1649                   printf("struct = %s\n",$1); 
     1650                   strcpy($$,$1);} 
     1651                   } 
    15921652      | array_ele_substring_func_ref 
    1593                    {if ( couldaddvariable == 1 ) strcpy($$,$1);} 
     1653                   {if ( couldaddvariable == 1 ) { 
     1654                   printf("arrayref = %s\n",$1); 
     1655                   strcpy($$,$1); 
     1656                   }} 
    15941657      ; 
    15951658beforefunctionuse : { 
    … …  
    16621725      ; 
    16631726ident : TOK_NAME    { 
    1664                        if ( couldaddvariable == 1 ) 
     1727                       if ( couldaddvariable == 1 && afterpercent == 0) 
    16651728                       { 
    16661729                       if ( Vartonumber($1) == 1 ) 
    … …  
    16731736                       if ( VariableIsNotFunction($1) == 0 ) 
    16741737                       { 
     1738                       printf("var = %s\n",$1); 
    16751739                          if ( inagrifcallargument == 1 ) 
    16761740                          { 
    … …  
    16851749                          strcpy(truename,$1); 
    16861750                          if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1)); 
    1687 /* 
    1688                           if ( VarIsNonGridDepend($1) == 0 && 
    1689                                Variableshouldberemove($1) == 0 ) 
    1690                           { 
    1691                              if ( inagrifcallargument == 1 || 
    1692                                   varisallocatable_0($1) == 1 || 
    1693                                   varispointer_0($1) == 1 ) 
    1694                              { 
    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)); 
    1710                              } 
    1711                              if ( inagrifcallargument != 1 || 
    1712                                   sameagrifargument ==1 ) 
    1713                                   Add_UsedInSubroutine_Var_1($1); 
    1714                           } 
    1715                           NotifyAgrifFunction_0($1); 
    1716 */ 
     1751 
    17171752                          if ( VarIsNonGridDepend(truename) == 0 && 
    17181753                               Variableshouldberemove(truename) == 0 ) 
    1719                           { 
     1754                          {                       
    17201755                             if ( inagrifcallargument == 1 || 
    1721                                   varisallocatable_0(truename) == 1 || 
    17221756                                  varispointer_0(truename) == 1 ) 
    17231757                             { 
     1758                             printf("var2 = %s\n",$1); 
    17241759                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1)) 
    17251760                             { 
    … …  
    17301765                                 } 
    17311766                             } 
     1767                             printf("ici3\n"); 
    17321768                             if ( inagrifcallargument != 1 || 
    17331769                                  sameagrifargument ==1 ) 
     1770                                  { 
     1771                                  printf("ici5 %s\n",truename); 
    17341772                                  Add_UsedInSubroutine_Var_1(truename); 
     1773                          } 
    17351774                          } 
    17361775                          NotifyAgrifFunction_0(truename); 
    17371776                       } 
    17381777                       } 
     1778                       else 
     1779                       { 
     1780                       afterpercent = 0; 
     1781                    } 
    17391782                    } 
    17401783      ; 
    … …  
    21622205                      else 
    21632206                      { 
     2207                      incontainssubroutine = 1; 
     2208                      strcpy(previoussubroutinename,subroutinename); 
    21642209                       if ( couldaddvariable == 1 ) 
    21652210                       { 
    … …  
    24262471      | '*' 
    24272472      | TOK_DASTER 
    2428       | TOK_NAME expr 
    2429       | TOK_NAME expr '%' ident_dims 
    2430       | TOK_NAME '(' triplet ')' 
    2431       | TOK_NAME '*' 
    2432       | TOK_NAME TOK_DASTER 
     2473      | ident expr 
     2474      | ident expr '%' ident_dims 
     2475      | ident '(' triplet ')' 
     2476      | ident '*' 
     2477      | ident TOK_DASTER 
    24332478      ; 
    24342479iofctl : TOK_OPEN 
    … …  
    25742619   int confirmyes; 
    25752620 
    2576    /*fortrandebug = 1;*/ 
     2621/*   fortrandebug = 1;*/ 
    25772622   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass); 
    25782623/******************************************************************************/ 
    … …  
    26382683   VarTypepar = 0; 
    26392684   Allocatabledeclare = 0 ; 
     2685   Targetdeclare = 0 ; 
    26402686   strcpy(NamePrecision," "); 
    26412687   VariableIsParameter =  0 ; 
    … …  
    26442690   functiondeclarationisdone = 0; 
    26452691   insubroutinedeclare = 0 ; 
     2692   ininterfacedeclare = 0 ;    
    26462693   strcpy(subroutinename," "); 
     2694   isrecursive = 0; 
    26472695   InitialValueGiven = 0 ; 
    26482696   strcpy(EmptyChar," "); 
    26492697   inmoduledeclare = 0; 
     2698   incontainssubroutine = 0; 
    26502699   colnum=0; 
    26512700   incom=0; 
    26522701   couldaddvariable=1; 
     2702   afterpercent = 0; 
    26532703   aftercontainsdeclare = 1; 
    26542704   strcpy(nameinttypename,""); 
    … …  
    26642714      fortranout=fopen(nomfileoutput,"w"); 
    26652715 
    2666       NewModule_Creation_0(); 
     2716/*      NewModule_Creation_0();*/ 
    26672717   } 
    26682718 
    26692719   fortranparse(); 
    26702720 
     2721   if (firstpass == 0 ) 
     2722   { 
     2723   NewModule_Creation_0(); 
     2724   } 
     2725    
    26712726   strcpy(curfile,mainfile); 
    26722727 
    2673    if (firstpass == 0 ) fclose(fortranout); 
     2728   if (firstpass == 0 ) 
     2729   { 
     2730   fclose(fortranout); 
     2731   } 
    26742732} 
Note: See TracChangeset for help on using the changeset viewer.