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 14107 for vendors/AGRIF/dev/LEX – NEMO

Ignore:
Timestamp:
2020-12-04T18:02:20+01:00 (3 years ago)
Author:
nicolasmartin
Message:

Reintegration of dev_r12970_AGRIF_CMEMS to AGRIF/dev

Location:
vendors/AGRIF/dev/LEX
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • vendors/AGRIF/dev/LEX/Makefile.lex

    r9140 r14107  
    11LEX      = flex -i 
    2 YACC  = bison -t -v -g 
     2YACC  = /usr/bin/bison -t -v -g --graph 
     3#YACC = byacc -t -v 
    34 
    45all: main.c fortran.c 
    56 
    67main.c : convert.tab.c convert.yy.c 
    7    cat   convert.tab.c convert.yy.c > ../LIB/main.c 
     8   cat   convert.tab.c convert.yy.c > main.c 
    89   $(RM) convert.tab.c convert.yy.c 
    910 
    1011fortran.c : fortran.tab.c fortran.yy.c 
    11    cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c 
     12   cat   fortran.tab.c fortran.yy.c > fortran.c 
    1213   $(RM) fortran.tab.c fortran.yy.c 
    1314 
     
    2930 
    3031clean-all: clean 
    31    $(RM) ../LIB/main.c ../LIB/fortran.c 
     32   $(RM) main.c fortran.c 
  • vendors/AGRIF/dev/LEX/convert.y

    r9140 r14107  
    130130    int infreegiven ; 
    131131    int infixedgiven ; 
    132     int lengthmainfile; 
    133132 
    134133    char filetoparse[LONG_FNAME]; 
     
    160159    tmpuselocallist = (listusemodule *) NULL; 
    161160    List_ContainsSubroutine = (listnom *) NULL; 
     161    List_Do_labels = (listname *) NULL; 
    162162    oldfortran_out = (FILE *) NULL; 
    163163 
    164     if (argc < 2) print_usage(); 
    165      
     164    if ( argc < 2 ) 
     165        print_usage(); 
     166 
    166167    strcpy(config_file, argv[1]); 
    167168    strcpy(work_dir, "."); 
     
    257258            strcpy(filetoparse, argv[i+1]); 
    258259            i++; 
    259             lengthmainfile = strlen(filetoparse); 
    260             if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90")) 
    261             { 
    262                 infixed = 0; 
    263                 infree = 1; 
    264             } 
    265             else 
    266             { 
    267                 infixed = 1; 
    268                 infree = 0; 
    269             } 
     260            infree  = (strstr(filetoparse, ".f90") != NULL) || (strstr(filetoparse, ".F90") != NULL); 
     261            infixed = ! infree; 
    270262        } 
    271263        else if (!strcasecmp(argv[i], "-free")) 
     
    400392    /* Build new subroutines                                                   */ 
    401393    firstpass = 0; 
     394    /* 
     395    printf("**********************************\n"); 
     396    printf("SECOND PASSES \n"); 
     397    printf("**********************************\n"); 
     398    */ 
    402399    process_fortran(filetoparse); 
    403400 
  • vendors/AGRIF/dev/LEX/fortran.lex

    r9140 r14107  
    3939%s character 
    4040%x donottreat 
     41%x donottreat_interface 
     42%x includestate 
    4143%s fortran77style 
    4244%s fortran90style 
     
    4749extern FILE * yyin; 
    4850#define MAX_INCLUDE_DEPTH 30 
     51#define YY_BUF_SIZE 64000 
    4952YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH]; 
    50 int line_num_input = 1; 
     53int line_num_input = 0; 
    5154int newlinef90 = 0; 
    52 char tmpc; 
    53 #define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); } 
    54 #define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); } 
    55  
    56 /******************************************************************************/ 
    57 /**************PETITS PB NON PREVUS *******************************************/ 
    58 /******************************************************************************/ 
    59 /* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */ 
    60 /*            a prevu seulement       & a=b avec l'espace entre le symbole    */ 
    61 /*            de la 7eme et le debut de la ligne de commande                  */ 
    62 /*            le ! est aussi interdit comme symbole de la 7 eme colonne       */ 
    63 /*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */ 
    64 /******************************************************************************/ 
    65 #define YY_USER_ACTION  if (firstpass == 0) ECHO; 
     55int tmpc; 
     56 
     57int lastwasendofstmt = 1; 
     58 
     59extern char linebuf1[1024]; 
     60extern char linebuf2[1024]; 
     61 
     62int count_newlines(const char* str_in) 
     63{ 
     64    int k, i = 0; 
     65    for( k=0 ; k<strlen(str_in) ; k++) 
     66        if (str_in[k] == '\n') i++; 
     67    return i; 
     68} 
     69 
     70#define PRINT_LINE_NUM()   //  { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); } 
     71#define INCREMENT_LINE_NUM() { line_num_input+=count_newlines(fortran_text) ; PRINT_LINE_NUM(); } 
     72#define YY_USER_ACTION       { if (increment_nbtokens !=0) token_since_endofstmt++; increment_nbtokens = 1; if (token_since_endofstmt>=1) lastwasendofstmt=0; /*printf("VALLIJSDFLSD = %d %d %s \n",lastwasendofstmt,token_since_endofstmt,fortran_text); */ if (firstpass) { strcpy(linebuf1, linebuf2); strncpy(linebuf2, fortran_text,80);} \ 
     73                               else {my_position_before=setposcur();/*printf("muposition = %d\n",my_position_before);*/ECHO;} } 
     74#define YY_BREAK {/*printf("VALL = %d %d\n",lastwasendofstmt,token_since_endofstmt);*/if (token_since_endofstmt>=1) lastwasendofstmt=0; break;} 
    6675 
    6776void out_of_donottreat(void); 
     
    6978%} 
    7079 
    71 REAL8 "real*8"[ \t]*"(a-h,o-z)" 
    72  
    7380SLASH       "/" 
    74 DSLASH      "/"[ \t]*"/" 
    7581HEXA        Z\'[0-9a-fA-F]+\' 
    76 NAME        [a-zA-Z\_][a-zA-Z0-9\_]* 
    7782INTEGER     [0-9]+ 
    78  
     83NAME        [a-zA-Z][a-zA-Z0-9\_]* 
    7984EXPONENT    [edq][-+]?{INTEGER} 
    8085 
    81 BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n 
    82 END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n 
     86BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*([ \t\n]*(!.*\n)*)+\n 
     87END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*([ \t\n]*(!.*\n)*)+\n 
    8388 
    8489BEG_INTERFACE   ^[ \t]*interface 
     
    8792ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")" 
    8893 
    89 COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n))) 
    90 COMM_F90        ^[ \t]*!.*\n 
     94COMM_F77        ^[c*].*\n 
     95COMM_F90_1      ^([ \t\n]*(!.*\n)*)+\n 
    9196COMM_F90_2      !.* 
    92 NEXTLINEF90     "&".*\n+ 
    93 NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#") 
    94  
    95 LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+ 
     97NEXTLINEF90     &([ \t\n]|(!.*\n))* 
     98NEXTLINEF77     \n(([c*].*\n)|(([ \t]{0,4}|[ \t]{6,})!.*\n)|[\n])*[ ]{5}([a-z0-9&+$*.#/!;]) 
     99LABEL           ^[ 0-9]{1,5}[ \t]+ 
    96100 
    97101%% 
     
    99103  if (infree)  BEGIN(fortran90style) ; 
    100104 
    101 {REAL8}                     { return TOK_REAL8; } 
    102105subroutine                  { return TOK_SUBROUTINE; } 
    103106program                     { return TOK_PROGRAM; } 
    104107allocate                    { inallocate = 1; return TOK_ALLOCATE; } 
     108continue                    { return TOK_CONTINUE; } 
    105109nullify                    { return TOK_NULLIFY; } 
    106 null[ ]*\([ ]*\)            { return TOK_NULL_PTR; } 
    107110deallocate                  { inallocate = 1; return TOK_DEALLOCATE; } 
    108111result                      { return TOK_RESULT; } 
    109112function                    { return TOK_FUNCTION; } 
    110 end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;} 
    111 end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; } 
    112 end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;} 
    113 end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;} 
    114113end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;} 
    115 include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;} 
    116 ^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text); 
    117                               tmpc = (char) input(); unput(tmpc); 
    118                               if ( ( tmpc >= 'a' && tmpc <= 'z' ) || 
    119                                    ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE; 
    120                               else                                    return TOK_NAME; 
    121                             } 
     114include                     { pos_curinclude = setposcur()-9; BEGIN(includestate); } 
     115use                         { return TOK_USE;} 
    122116rewind                      { return TOK_REWIND; } 
    123117implicit                    { return TOK_IMPLICIT; } 
    124118none                        { return TOK_NONE; } 
    125119call                        { return TOK_CALL; } 
    126 .true.                      { return TOK_TRUE; } 
    127 .false.                     { return TOK_FALSE; } 
     120.true.                      { strcpy(yylval.na,fortran_text); return TOK_TRUE; } 
     121.false.                     { strcpy(yylval.na,fortran_text); return TOK_FALSE; } 
    128122\=\>                        { return TOK_POINT_TO; } 
    129123{ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;} 
    130124\*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; } 
    131 \.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; } 
    132 \.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  } 
    133 \.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  } 
    134 \.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  } 
    135 \.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  } 
    136 \.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  } 
    137 \.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;} 
    138 \.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  } 
    139 \.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; } 
    140 \.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  } 
     125\.eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; } 
     126\.[ \t]*eq[ \t]*\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  } 
     127\.gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  } 
     128\.ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  } 
     129\.lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  } 
     130\.le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  } 
     131\.neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;} 
     132\.[ \t]*ne[ \t]*\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  } 
     133\.not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; } 
     134\.or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  } 
    141135\.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; } 
    142 \.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; } 
     136\.and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; } 
     137\=\=                  { strcpy(yylval.na,fortran_text); return TOK_EQUALEQUAL; } 
     138\/\=                  { strcpy(yylval.na,fortran_text); return TOK_SLASHEQUAL; } 
     139\<\=                  { strcpy(yylval.na,fortran_text); return TOK_INFEQUAL; } 
     140\>\=                  { strcpy(yylval.na,fortran_text); return TOK_SUPEQUAL; } 
    143141module                      { return TOK_MODULE; } 
    144142while                       { return TOK_WHILE; } 
    145143concurrent                  { return TOK_CONCURRENT; } 
    146144end[ \t]*do                 { return TOK_ENDDO; } 
    147 do                          { return TOK_PLAINDO;} 
     145do[\ t]+{INTEGER}           { strcpy(yylval.na,&fortran_text[2]); 
     146                              if (testandextractfromlist(&List_Do_labels,&fortran_text[2]) == 1) 
     147                              { 
     148                              return TOK_PLAINDO_LABEL_DJVIEW; 
     149                              } 
     150                              else 
     151                              { 
     152                              List_Do_labels=Insertname(List_Do_labels,yylval.na,1); 
     153                              return TOK_PLAINDO_LABEL; 
     154                             } 
     155                             } 
     156do                          { increment_nbtokens = 0; return TOK_PLAINDO;} 
    148157real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; } 
    149158integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; } 
     
    153162double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; } 
    154163double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; } 
    155 complex                     { return TOK_COMPLEX; } 
     164complex                     { strcpy(yylval.na,fortran_text); return TOK_COMPLEX; } 
    156165allocatable                 { return TOK_ALLOCATABLE; } 
    157166close                       { return TOK_CLOSE; } 
     
    172181^[ \t]*global[ \t]+         { return TOK_GLOBAL; } 
    173182external                    { return TOK_EXTERNAL; } 
    174 intent                      { return TOK_INTENT; } 
     183intent                      { intent_spec = 1; return TOK_INTENT; } 
    175184pointer                     { return TOK_POINTER; } 
    176185optional                    { return TOK_OPTIONAL; } 
    177186save                        { return TOK_SAVE; } 
    178 ^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; } 
    179 ^[ \t]*type[ \t\,]+         { return TOK_TYPE; } 
     187^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-strlen(fortran_text); return TOK_TYPEPAR; } 
     188^[ \t]*type/[ \t\,:]+       { return TOK_TYPE; } 
    180189end[ \t]*type               { return TOK_ENDTYPE; } 
    181190stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } } 
    182191open                        { return TOK_OPEN; } 
    183192return                      { return TOK_RETURN; } 
    184 exit[^(]                    { return TOK_EXIT; } 
     193exit                        { return TOK_EXIT; } 
    185194print                       { return TOK_PRINT; } 
    186195module[ \t]*procedure       { return TOK_PROCEDURE; } 
     196read[ \t]*\(                { in_io_control_spec = 1; return TOK_READ_PAR; } 
    187197read                        { return TOK_READ; } 
    188198namelist                    { return TOK_NAMELIST; } 
     199write[ \t]*\(               { in_io_control_spec = 1; return TOK_WRITE_PAR; } 
    189200write                       { return TOK_WRITE; } 
    190 flush                       { return TOK_FLUSH; } 
     201flush                       { strcpy(yylval.na,fortran_text); return TOK_FLUSH; } 
    191202target                      { return TOK_TARGET; } 
    192203public                      { return TOK_PUBLIC; } 
    193204private                     { return TOK_PRIVATE; } 
    194 in                          { strcpy(yylval.na,fortran_text); return TOK_IN; } 
    195 ^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; } 
    196 continue                    { return TOK_CONTINUE; } 
     205in                          { strcpy(yylval.na,fortran_text); 
     206                               if (intent_spec==1) 
     207                                {return TOK_IN; } 
     208                              else 
     209                              { 
     210                              return TOK_NAME; 
     211                              } 
     212                            } 
     213^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); /*Init_List_Data_Var();*/ return TOK_DATA; } 
    197214go[ \t]*to                  { return TOK_PLAINGOTO; } 
    198 out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; } 
    199 inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; } 
     215out                         { strcpy(yylval.na,fortran_text); 
     216                               if (intent_spec==1) 
     217                                {return TOK_OUT; } 
     218                              else 
     219                              { 
     220                              return TOK_NAME; 
     221                              } 
     222                            } 
     223inout                       { strcpy(yylval.na,fortran_text); 
     224                               if (intent_spec==1) 
     225                                {return TOK_IN; } 
     226                              else 
     227                              { 
     228                              return TOK_INOUT; 
     229                              } 
     230                            } 
    200231intrinsic                   { return TOK_INTRINSIC; } 
    201232then                        { return TOK_THEN; } 
     
    203234else                        { return TOK_ELSE; } 
    204235end[ \t]*if                 { return TOK_ENDIF; } 
    205 if                          { return TOK_LOGICALIF; } 
    206 sum[ \t]*\(                 { return TOK_SUM; } 
    207 max[ \t]*\(                 { return TOK_MAX; } 
    208 tanh                        { return TOK_TANH; } 
    209 maxval                      { return TOK_MAXVAL; } 
    210 trim                        { return TOK_TRIM; } 
    211 sqrt\(                      { return TOK_SQRT; } 
     236if[ \t]*\(/(.*\)[ \t]*[\=|\+|\-]+.*\))   {strcpy(yylval.na,fortran_text); 
     237                            return TOK_LOGICALIF_PAR; 
     238                            } 
     239if/([ \t]*\([^(]*\)[ \t]*[\=|\+|\-]+)   {strcpy(yylval.na,fortran_text); 
     240                            return TOK_NAME; 
     241                            } 
     242if[ \t]*\(                 {strcpy(yylval.na,fortran_text); 
     243                            return TOK_LOGICALIF_PAR; 
     244                            } 
    212245select[ \t]*case            { return TOK_SELECTCASE; } 
    213 ^[ \t]*case[ \t]*           { return TOK_CASE; } 
     246^[ \t]*case[ \t]*           { if (in_select_case_stmt > 0) return TOK_CASE ; else return TOK_NAME;} 
    214247default                     { return TOK_DEFAULT; } 
    215248end[ \t]*select             { return TOK_ENDSELECT; } 
    216249file[ \t]*\=                { return TOK_FILE; } 
     250access[ \t]*\=                { return TOK_ACCESS; } 
     251action[ \t]*\=                { return TOK_ACTION; } 
     252iolength[ \t]*\=                { return TOK_IOLENGTH; } 
    217253unit[ \t]*\=                { return TOK_UNIT; } 
     254opened[ \t]*\=                { return TOK_OPENED; } 
    218255fmt[ \t]*\=                 { return TOK_FMT; } 
    219256nml[ \t]*\=                 { return TOK_NML; } 
    220257end[ \t]*\=                 { return TOK_END; } 
    221258eor[ \t]*\=                 { return TOK_EOR; } 
     259len/([ \t]*\=)                 { 
     260                            if (in_char_selector ==1) 
     261                               return TOK_LEN; 
     262                            else 
     263                            { 
     264                            strcpy(yylval.na,fortran_text); return TOK_NAME; 
     265                            } 
     266                            } 
     267kind/([ \t]*\=)            { 
     268                            if ((in_char_selector==1) || (in_kind_selector == 1)) 
     269                               return TOK_KIND; 
     270                            else 
     271                            { 
     272                            strcpy(yylval.na,fortran_text); return TOK_NAME; 
     273                            } 
     274                            } 
     275errmsg[ \t]*\=              { return TOK_ERRMSG; } 
     276mold[ \t]*\=              { return TOK_MOLD; } 
     277source[ \t]*\=              { return TOK_SOURCE; } 
     278position[ \t]*\=            { return TOK_POSITION; } 
     279iomsg[ \t]*\=               { return TOK_IOMSG; } 
     280iostat[ \t]*\=              { return TOK_IOSTAT; } 
    222281err[ \t]*\=                 { return TOK_ERR; } 
     282form[ \t]*\=                { return TOK_FORM; } 
     283name/([ \t]*\=)             { 
     284                            if (in_inquire==1) 
     285                               return TOK_NAME_EQ; 
     286                            else 
     287                            { 
     288                            strcpy(yylval.na,fortran_text); return TOK_NAME; 
     289                            } 
     290                            } 
     291recl[ \t]*\=                { return TOK_RECL; } 
     292rec/([ \t]*\=)              { if (in_io_control_spec == 1) 
     293                              return TOK_REC; 
     294                             else 
     295                             { 
     296                             strcpy(yylval.na,fortran_text); return TOK_NAME; 
     297                             } 
     298                             } 
     299status/([ \t]*\=)           { if (close_or_connect == 1) 
     300                              return TOK_STATUS; 
     301                             else 
     302                             { 
     303                             strcpy(yylval.na,fortran_text); return TOK_NAME; 
     304                             } 
     305                             } 
     306status                      { strcpy(yylval.na,fortran_text); return TOK_NAME;} 
    223307exist[ \t]*\=               { return TOK_EXIST; } 
    224 min[ \t]*\(                 { return TOK_MIN; } 
    225 nint                        { return TOK_NINT; } 
    226 float                       { return TOK_FLOAT; } 
    227 exp                         { return TOK_EXP; } 
    228 cos                         { return TOK_COS; } 
    229 cosh                        { return TOK_COSH; } 
    230 acos                        { return TOK_ACOS; } 
    231 sin                         { return TOK_SIN; } 
    232 sinh                        { return TOK_SINH; } 
    233 asin                        { return TOK_ASIN; } 
    234 log                         { return TOK_LOG; } 
    235 tan                         { return TOK_TAN; } 
    236 atan                        { return TOK_ATAN; } 
    237308cycle                       { return TOK_CYCLE; } 
    238 abs[ \t]*\(                 { return TOK_ABS; } 
    239 mod                         { return TOK_MOD; } 
    240 sign[ \t]*\(                { return TOK_SIGN; } 
    241 minloc                      { return TOK_MINLOC; } 
    242 maxloc                      { return TOK_MAXLOC; } 
    243 minval                      { return TOK_MINVAL; } 
    244309backspace                   { return TOK_BACKSPACE; } 
    245310::                          { return TOK_FOURDOTS;  } 
     311\/[ \t]*({NEXTLINEF90}|{NEXTLINEF77})*[ \t]*\/  { strcpy(yylval.na,fortran_text); return TOK_DSLASH; } 
    246312\({SLASH}                   { return TOK_LEFTAB; } 
    247313{SLASH}\)                   { return TOK_RIGHTAB; } 
    248 format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  { 
    249                               return TOK_FORMAT; } 
    250314{SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; } 
    251 DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; } 
    252 (\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') { 
    253                               strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; } 
    254 (\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; } 
    255 (\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; } 
    256 {BEG_INTERFACE}             { BEGIN(donottreat); } 
    257 <donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; } 
     315((\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\'))+ { 
     316                              INCREMENT_LINE_NUM() ; strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; } 
     317<includestate>((\')[^']*(\'))+ {Add_Include_1(fortran_text);} 
     318<includestate>[ \t]* {} 
     319<includestate>\n { 
     320                  if (inmoduledeclare == 0 ) 
     321                  { 
     322                  pos_end=setposcur(); 
     323                  RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); 
     324                  } 
     325                  out_of_donottreat(); 
     326                  } 
     327((\')[^']*(\'))+               { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; } 
     328((\")[^"]*(\"))+               { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; } 
     329{BEG_INTERFACE}             { BEGIN(donottreat_interface); } 
     330<donottreat_interface>{END_INTERFACE} { out_of_donottreat(); return '\n'; } 
     331<donottreat_interface>.*\n            {INCREMENT_LINE_NUM() ; } 
     332<fortran77style>{NAME}{NEXTLINEF77}[a-zA-Z0-9\_]+ {strcpy(yylval.na,fortran_text); removenewline(yylval.na); 
     333                            return TOK_NAME; } 
    258334{NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; } 
     335{INTEGER}\.[0-9]+           {strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } 
    259336({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1 
    260337                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } 
    261338(({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2 
    262339                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } 
    263 {INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; } 
     340{INTEGER}                   { strcpy(yylval.na,fortran_text); 
     341                             if (lastwasendofstmt == 0) 
     342                              return TOK_CSTINT; 
     343                             else 
     344                              if (testandextractfromlist(&List_Do_labels,fortran_text) == 1) 
     345                              { 
     346                              removefromlist(&List_Do_labels,yylval.na); 
     347                              return TOK_LABEL_DJVIEW; 
     348                              } 
     349                              else 
     350                              { 
     351                              return TOK_LABEL; 
     352                              } 
     353                             } 
    264354\$                          {} 
    265355\.                          {} 
    266 \(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; } 
     356\(/([ \t]*[\+\-]?[a-zA-Z0-9]+[\.]*[0-9]*(\_({INTEGER}|{NAME}))?[ \t]*\,[ \t]*[\+\-]?[a-zA-Z0-9]+[\.]*[0-9]*(\_({INTEGER}|{NAME}))?[ \t]*\)) { 
     357                            in_complex_literal = -1; 
     358                            return (int) *fortran_text; 
     359                            } 
     360\(|\)|:|\[|\]|\+|\-|\*|\_   { strcpy(yylval.na,fortran_text); return (int) *fortran_text; } 
    267361\%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; } 
    268 \;                          { return TOK_SEMICOLON; } 
    269 \,                          { return (int) *fortran_text; } 
     362\;                          { lastwasendofstmt=1; token_since_endofstmt = 0; return TOK_SEMICOLON; } 
     363\,                          { if (in_complex_literal==-1) {return TOK_COMMACOMPLEX; in_complex_literal=0;} else; return (int) *fortran_text; } 
    270364\=                          { return (int) *fortran_text; } 
    271365\<                          { return (int) *fortran_text; } 
    272366\>                          { return (int) *fortran_text; } 
    273 \n                          { INCREMENT_LINE_NUM() ; return '\n'; } 
    274 ^[ ]*$                      {} 
    275 [ \t]+                      {} 
    276 {LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; } 
     367\n                          { INCREMENT_LINE_NUM() ; lastwasendofstmt=1; token_since_endofstmt = 0; increment_nbtokens = 0; return '\n'; } 
     368[ \t]+                      {increment_nbtokens = 0;} 
     369<fortran77style>{LABEL}[ \t]*format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  { 
     370                              return TOK_LABEL_FORMAT; } 
     371<fortran90style>^[ \t]*{INTEGER}[ \t]*format[ \t]*\((.|{NEXTLINEF90})*\) {return TOK_LABEL_FORMAT; } 
    277372{NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; } 
    278 {NEXTLINEF77}               { INCREMENT_LINE_NUM() ; } 
    279  
    280 {BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); } 
    281 <donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; } 
    282 <donottreat>.*\n            { INCREMENT_LINE_NUM() ; } 
    283 <fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; } 
    284 {COMM_F90}                  { INCREMENT_LINE_NUM() ; } 
    285 {COMM_F90_2}                {} 
     373<fortran77style>{NEXTLINEF77}               { INCREMENT_LINE_NUM() ;} 
     374 
     375{BEG_DNT}                   {INCREMENT_LINE_NUM() ; BEGIN(donottreat); } 
     376<donottreat>{END_DNT}       {out_of_donottreat(); return '\n'; } 
     377<donottreat>.*\n            {INCREMENT_LINE_NUM() ; } 
     378<fortran77style>{COMM_F77}  {INCREMENT_LINE_NUM() ; increment_nbtokens = 0;} 
     379{COMM_F90_1}                {INCREMENT_LINE_NUM() ; increment_nbtokens = 0;} 
     380{COMM_F90_2}                {increment_nbtokens = 0;} 
     381<<EOF>>                     {endoffile = 1; yyterminate();} 
    286382%% 
    287383 
  • vendors/AGRIF/dev/LEX/fortran.y

    r12420 r14107  
    4242 
    4343extern int line_num_input; 
    44 extern char *fortran_text; 
    4544 
    4645char c_selectorname[LONG_M]; 
     
    5049int c_selectorgiven=0; 
    5150listvar *curlistvar; 
     51int in_select_case_stmt=0; 
    5252typedim c_selectordim; 
    5353listcouple *coupletmp; 
    5454int removeline=0; 
     55int token_since_endofstmt = 0; 
     56int increment_nbtokens = 1; 
     57int in_complex_literal = 0; 
     58int close_or_connect = 0; 
     59int in_io_control_spec = 0; 
     60int intent_spec = 0; 
     61long int my_position; 
     62long int my_position_before; 
     63int suborfun = 0; 
     64int indeclaration = 0; 
     65int endoffile = 0; 
     66int in_inquire = 0; 
     67int in_char_selector = 0; 
     68int in_kind_selector =0; 
     69int char_length_toreset = 0; 
     70 
     71typedim my_dim; 
     72 
    5573listvar *test; 
     74 
     75char linebuf1[1024]; 
     76char linebuf2[1024]; 
    5677 
    5778int fortran_error(const char *s) 
    5879{ 
    59     printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text); 
     80  if (endoffile == 1)  
     81  { 
     82  endoffile = 0; 
     83  return 0; 
     84  } 
     85    printf("%s line %d, file %s culprit = |%s|\n", s, line_num_input, cur_filename, strcat(linebuf1, linebuf2)); 
    6086    exit(1); 
    6187} 
     
    94120%token TOK_PROGRAM 
    95121%token TOK_FUNCTION 
    96 %token TOK_FORMAT 
     122%token TOK_LABEL_FORMAT 
     123%token TOK_LABEL_CONTINUE 
     124%token TOK_LABEL_END_DO 
    97125%token TOK_MAX 
    98126%token TOK_TANH 
     127%token TOK_COMMENT 
    99128%token TOK_WHERE 
    100129%token TOK_ELSEWHEREPAR 
     
    109138%token TOK_SELECTCASE 
    110139%token TOK_FILE 
     140%token TOK_REC 
     141%token TOK_NAME_EQ 
     142%token TOK_IOLENGTH 
     143%token TOK_ACCESS 
     144%token TOK_ACTION 
     145%token TOK_FORM 
     146%token TOK_RECL 
     147%token TOK_STATUS 
    111148%token TOK_UNIT 
     149%token TOK_OPENED 
    112150%token TOK_FMT 
    113151%token TOK_NML 
    114152%token TOK_END 
    115153%token TOK_EOR 
     154%token TOK_EOF 
    116155%token TOK_ERR 
     156%token TOK_POSITION 
     157%token TOK_IOSTAT 
     158%token TOK_IOMSG 
    117159%token TOK_EXIST 
    118160%token TOK_MIN 
    119161%token TOK_FLOAT 
    120162%token TOK_EXP 
     163%token TOK_LEN 
    121164%token TOK_COS 
    122165%token TOK_COSH 
     
    139182%token TOK_MAXLOC 
    140183%token TOK_EXIT 
     184%token TOK_KIND 
     185%token TOK_MOLD 
     186%token TOK_SOURCE 
     187%token TOK_ERRMSG 
    141188%token TOK_MINVAL 
    142189%token TOK_PUBLIC 
     
    150197%token TOK_PRINT 
    151198%token TOK_PLAINGOTO 
    152 %token TOK_LOGICALIF 
     199%token <na> TOK_LOGICALIF 
     200%token <na> TOK_LOGICALIF_PAR 
    153201%token TOK_PLAINDO 
    154202%token TOK_CONTAINS 
     
    162210%token TOK_CLOSE 
    163211%token TOK_INQUIRE 
     212%token TOK_WRITE_PAR 
    164213%token TOK_WRITE 
    165 %token TOK_FLUSH 
     214%token <na> TOK_FLUSH 
     215%token TOK_READ_PAR 
    166216%token TOK_READ 
    167217%token TOK_REWIND 
     
    192242%token TOK_PROCEDURE 
    193243%token TOK_STOP 
    194 %token TOK_REAL8 
    195244%token TOK_FOURDOTS 
    196245%token <na> TOK_HEXA 
     
    214263%token <na> TOK_NOT 
    215264%token <na> TOK_AND 
     265%token <na> TOK_EQUALEQUAL 
     266%token <na> TOK_SLASHEQUAL 
     267%token <na> TOK_INFEQUAL 
     268%token <na> TOK_SUPEQUAL 
    216269%token <na> TOK_TRUE 
    217270%token <na> TOK_FALSE 
    218271%token <na> TOK_LABEL 
     272%token <na> TOK_LABEL_DJVIEW 
     273%token <na> TOK_PLAINDO_LABEL_DJVIEW 
     274%token <na> TOK_PLAINDO_LABEL 
    219275%token <na> TOK_TYPE 
    220276%token <na> TOK_TYPEPAR 
    221277%token <na> TOK_ENDTYPE 
     278%token TOK_COMMACOMPLEX 
    222279%token <na> TOK_REAL 
    223280%token <na> TOK_INTEGER 
     
    246303%token '>' 
    247304%type <l> dcl 
    248 %type <l> after_type 
    249305%type <l> dimension 
     306%type <l> array-name-spec-list 
    250307%type <l> paramlist 
    251308%type <l> args 
     309%type <na> declaration-type-spec 
    252310%type <l> arglist 
    253311%type <lc> only_list 
     312%type <lc> only-list 
     313%type <lc> opt-only-list 
     314%type <lc> only 
    254315%type <lc> only_name 
    255 %type <lc> rename_list 
    256 %type <lc> rename_name 
     316%type <lc> rename-list 
     317%type <lc> opt-rename-list 
     318%type <lc> rename 
    257319%type <d> dims 
    258320%type <d> dimlist 
     
    261323%type <na> comblock 
    262324%type <na> name_routine 
     325%type <na> type-param-value 
    263326%type <na> opt_name 
     327%type <na> constant-expr 
     328%type <na> ac-implied-do 
     329%type <na> subroutine-name 
     330%type <l> opt-dummy-arg-list-par 
     331%type <l> opt-dummy-arg-list 
     332%type <l> dummy-arg-list 
     333%type <l> named-constant-def-list 
     334%type <v> named-constant-def 
     335%type <na> ac-do-variable 
     336%type <na> data-i-do-variable 
     337%type <na> data-stmt-constant 
     338%type <na> do-variable 
     339%type <na> ac-implied-do-control 
     340%type <na> label 
     341%type <na> opt-label 
     342%type <na> label-djview 
     343%type <na> opt-label-djview 
    264344%type <na> type 
    265 %type <na> word_endsubroutine 
    266 %type <na> word_endfunction 
    267 %type <na> word_endprogram 
    268 %type <na> word_endunit 
     345%type <na> real-literal-constant 
     346%type <l> type-declaration-stmt 
     347%type <d> array-spec 
     348%type <d> assumed-shape-spec-list 
     349%type <d> deferred-shape-spec-list 
     350%type <d> assumed-size-spec 
     351%type <d> implied-shape-spec-list 
    269352%type <na> typespec 
     353%type <na> null-init 
     354%type <na> initial-data-target 
     355%type <na> intent-spec 
    270356%type <na> string_constant 
     357%type <na> access-id 
     358%type <na> dummy-arg-name 
     359%type <na> common-block-name 
     360%type <na> function-name 
     361%type <na> dummy-arg 
     362%type <na> lower-bound 
     363%type <na> upper-bound 
     364%type <na> scalar-constant-subobject 
     365%type <na> opt-data-stmt-star 
    271366%type <na> simple_const 
     367%type <na> opt-char-selector 
     368%type <na> char-selector 
    272369%type <na> ident 
    273370%type <na> intent_spec 
     371%type <na> kind-param 
    274372%type <na> signe 
     373%type <na> scalar-int-constant-expr 
    275374%type <na> opt_signe 
     375%type <dim1> explicit-shape-spec 
     376%type <d> explicit-shape-spec-list 
     377%type <dim1> assumed-shape-spec 
     378%type <dim1> deferred-shape-spec 
    276379%type <na> filename 
    277380%type <na> attribute 
     
    279382%type <na> begin_array 
    280383%type <na> clause 
     384%type <na> only-use-name 
     385%type <na> generic-spec 
    281386%type <na> arg 
     387%type <d> opt-array-spec-par 
     388%type <d> opt-explicit-shape-spec-list-comma 
     389%type <d> explicit-shape-spec-list-comma 
    282390%type <na> uexpr 
     391%type <na> section_subscript_ambiguous 
    283392%type <na> minmaxlist 
     393%type <na> subscript 
     394%type <na> subscript-triplet 
     395%type <na> vector-subscript 
    284396%type <na> lhs 
    285 %type <na> vec 
    286397%type <na> outlist 
    287398%type <na> other 
     399%type <na> int-constant-expr 
    288400%type <na> dospec 
    289401%type <na> expr_data 
     
    298410%type <na> opt_expr 
    299411%type <na> optexpr 
     412%type <v> entity-decl 
     413%type <l> entity-decl-list 
    300414%type <lnn> data_stmt_value_list 
     415%type <lnn> data-stmt-value-list 
     416%type <lnn> access-id-list 
     417%type <lnn> opt-access-id-list 
     418%type <na> data-stmt-value 
     419%type <l> data-stmt-object-list 
     420%type <l> data-i-do-object-list 
     421%type <v> data-stmt-object 
     422%type <v> data-i-do-object 
    301423%type <lnn> datanamelist 
    302424%type <na> after_slash 
    303425%type <na> after_equal 
    304426%type <na> predefinedfunction 
     427%type <na> equiv-op 
     428%type <na> or-op 
     429%type <na> and-op 
     430%type <na> not-op 
     431%type <na> equiv-operand 
     432%type <na> or-operand 
     433%type <na> and-operand 
     434%type <na> mult-operand 
     435%type <na> rel-op 
     436%type <na> concat-op 
     437%type <na> add-operand 
     438%type <na> add-op 
     439%type <na> power-op 
     440%type <na> section-subscript-list 
     441%type <na> opt-lower-bound-2points 
     442%type <na> mult-op 
     443%type <na> array-constructor 
    305444%type <na> expr 
     445%type <na> function-reference 
     446%type <na> literal-constant 
     447%type <na> named-constant 
     448%type <na> ac-value-list 
     449%type <na> ac-value 
     450%type <na> intrinsic-type-spec 
     451%type <na> opt-kind-selector 
     452%type <na> char-literal-constant 
     453%type <na> logical-literal-constant 
     454%type <na> real-part 
     455%type <na> imag-part 
     456%type <na> sign 
     457%type <na> signed-int-literal-constant 
     458%type <na> int-literal-constant 
     459%type <na> signed-real-literal-constant 
     460%type <na> complex-literal-constant 
     461%type <na> actual-arg-spec-list 
     462%type <na> procedure-designator 
     463%type <na> constant 
     464%type <na> data-ref 
     465%type <v> structure-component 
     466%type <v> scalar-structure-component 
     467%type <na> int-expr 
     468%type <na> ac-spec 
     469%type <na> type-spec 
     470%type <na> derived-type-spec 
     471%type <v> part-ref 
     472%type <na> opt-part-ref 
     473%type <na> actual-arg-spec 
     474%type <na> kind-selector 
     475%type <na> actual-arg 
     476%type <na> section-subscript 
     477%type <na> keyword 
     478%type <na> primary 
     479%type <na> specification-expr 
     480%type <v> variable 
     481%type <v> data-implied-do 
     482%type <na> substring-range 
     483%type <v> designator 
     484%type <na> object-name 
     485%type <na> object-name-noident 
     486%type <na> array-element 
     487%type <na> array-section 
     488%type <na> scalar-variable-name 
     489%type <na> scalar-constant 
     490%type <na> variable-name 
     491%type <na> opt-subscript  
     492%type <na> stride 
     493%type <na> opt-scalar-int-expr 
     494%type <na> scalar-int-expr 
     495%type <na> level-1-expr 
     496%type <na> level-2-expr 
     497%type <na> level-3-expr 
     498%type <na> level-4-expr 
     499%type <na> level-5-expr 
    306500%type <na> ubound 
    307501%type <na> operation 
     
    311505 
    312506%% 
    313 input : 
     507/* R201 : program */ 
     508/*program: line-break 
     509     | program-unit 
     510     | program program-unit 
     511     ; 
     512*/ 
     513 
     514input: 
    314515      | input line 
    315516      ; 
    316 line :  line-break 
     517line:  line-break 
    317518      | suite_line_list 
    318       | TOK_LABEL suite_line_list 
    319519      | error {yyerrok;yyclearin;} 
    320520      ; 
    321 line-break: 
    322         '\n' fin_line 
     521line-break: '\n' fin_line 
     522      {token_since_endofstmt = 0; increment_nbtokens = 0;} 
    323523      | TOK_SEMICOLON 
     524      | TOK_EOF 
    324525      | line-break '\n' fin_line 
    325526      | line-break TOK_SEMICOLON 
    326       | line-break TOK_LABEL 
    327527      ; 
    328528suite_line_list : 
     
    331531      | suite_line_list TOK_SEMICOLON suite_line 
    332532      ; 
    333 suite_line : 
    334         entry fin_line     /* subroutine, function, module                    */ 
    335       | spec fin_line      /* declaration                                     */ 
     533suite_line:program-unit 
    336534      | TOK_INCLUDE filename fin_line 
    337535        { 
     
    342540            } 
    343541        } 
     542      | TOK_COMMENT 
     543      ; 
     544/* 
     545suite_line: 
     546        entry fin_line     subroutine, function, module                     
     547      | spec fin_line       declaration                                      
     548      | TOK_INCLUDE filename fin_line 
     549        { 
     550            if (inmoduledeclare == 0 ) 
     551            { 
     552                pos_end = setposcur(); 
     553                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); 
     554            } 
     555        } 
    344556      | execution-part-construct 
    345557      ; 
    346  
    347 fin_line : { pos_cur = setposcur(); } 
    348       ; 
    349  
     558*/ 
     559 
     560fin_line: { pos_cur = setposcur(); } 
     561      ; 
     562 
     563/* R202 : program-unit */ 
     564program-unit: main-program 
     565     | external-subprogram 
     566     | module 
     567     ; 
     568  
     569/*R203 : external-subprogram */ 
     570external-subprogram: function-subprogram 
     571     | subroutine-subprogram 
     572     ; 
     573      
    350574opt_recursive :         { isrecursive = 0; } 
    351575      | TOK_RECURSIVE   { isrecursive = 1; } 
     
    356580      ; 
    357581 
    358 entry : opt_recursive TOK_SUBROUTINE name_routine arglist 
    359         { 
    360             insubroutinedeclare = 1; 
    361             if ( firstpass ) 
    362                 Add_SubroutineArgument_Var_1($4); 
    363             else 
    364                 WriteBeginof_SubLoop(); 
    365         } 
    366       | TOK_PROGRAM name_routine 
    367         { 
    368             insubroutinedeclare = 1; 
    369             inprogramdeclare = 1; 
    370             /* in the second step we should write the head of       */ 
    371             /*    the subroutine sub_loop_<subroutinename>          */ 
    372             if ( ! firstpass ) 
    373                 WriteBeginof_SubLoop(); 
    374         } 
    375       | opt_recursive TOK_FUNCTION name_routine arglist opt_result 
    376         { 
    377             insubroutinedeclare = 1; 
    378             strcpy(DeclType, ""); 
    379             /* we should to list of the subroutine argument the  */ 
    380             /*    name of the function which has to be defined   */ 
    381             if ( firstpass ) 
    382             { 
    383                 Add_SubroutineArgument_Var_1($4); 
    384                 if ( ! is_result_present ) 
    385                     Add_FunctionType_Var_1($3); 
    386             } 
    387             else 
    388             /* in the second step we should write the head of    */ 
    389             /*    the subroutine sub_loop_<subroutinename>       */ 
    390                 WriteBeginof_SubLoop(); 
    391         } 
    392       | TOK_MODULE TOK_NAME 
    393         { 
    394             GlobalDeclaration = 0; 
    395             strcpy(curmodulename,$2); 
    396             strcpy(subroutinename,""); 
    397             Add_NameOfModule_1($2); 
    398             if ( inmoduledeclare == 0 ) 
    399             { 
    400                 /* To know if there are in the module declaration    */ 
    401                 inmoduledeclare = 1; 
    402                 /* to know if a module has been met                  */ 
    403                 inmodulemeet = 1; 
    404                 /* to know if we are after the keyword contains      */ 
    405                 aftercontainsdeclare = 0 ; 
    406             } 
    407         } 
    408       ; 
    409  
    410 /* R312 : label */ 
    411 label: TOK_CSTINT 
    412      | label TOK_CSTINT 
    413      ; 
    414  
    415582name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); } 
    416583      ; 
     
    419586arglist :               { if ( firstpass ) $$=NULL; } 
    420587      | '(' ')'         { if ( firstpass ) $$=NULL; } 
    421       | '(' args ')'    { if ( firstpass ) $$=$2; } 
     588      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) $$=$3; } 
    422589      ; 
    423590arglist_after_result: 
    424591      | '(' ')' 
    425       | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); } 
     592      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($3); } 
    426593      ; 
    427594args :  arg 
     
    452619      | '*'     { strcpy($$,"*"); } 
    453620      ; 
    454 spec :  type after_type 
    455       | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; } 
    456       | TOK_ENDTYPE opt_name                { inside_type_declare = 0; } 
    457       | TOK_POINTER list_couple 
    458       | before_parameter '(' paramlist ')' 
    459         { 
    460             if ( ! inside_type_declare ) 
    461             { 
    462                 if ( firstpass ) 
    463                 { 
    464                     if ( insubroutinedeclare )  Add_Parameter_Var_1($3); 
    465                     else                        Add_GlobalParameter_Var_1($3); 
    466                 } 
    467                 else 
    468                 { 
    469                     pos_end = setposcur(); 
    470                     RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl); 
    471                 } 
    472             } 
    473             VariableIsParameter =  0 ; 
    474         } 
    475       | before_parameter paramlist 
    476         { 
    477             if ( ! inside_type_declare ) 
    478             { 
    479                 if ( firstpass ) 
    480                 { 
    481                     if ( insubroutinedeclare )  Add_Parameter_Var_1($2); 
    482                     else                        Add_GlobalParameter_Var_1($2); 
    483                 } 
    484                 else 
    485                 { 
    486                     pos_end = setposcur(); 
    487                     RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl); 
    488                 } 
    489             } 
    490             VariableIsParameter =  0 ; 
    491         } 
    492       | common 
    493       | save 
    494         { 
    495             pos_end = setposcur(); 
    496             RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave); 
    497         } 
    498       | implicit 
    499       | dimension 
    500         { 
    501             /* if the variable is a parameter we can suppose that is   */ 
    502             /*    value is the same on each grid. It is not useless to */ 
    503             /*    create a copy of it on each grid                     */ 
    504             if ( ! inside_type_declare ) 
    505             { 
    506                 if ( firstpass ) 
    507                 { 
    508                     Add_Globliste_1($1); 
    509                     /* if variableparamlists has been declared in a subroutine   */ 
    510                     if ( insubroutinedeclare )     Add_Dimension_Var_1($1); 
    511                 } 
    512                 else 
    513                 { 
    514                     pos_end = setposcur(); 
    515                     RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension); 
    516                 } 
    517             } 
    518             PublicDeclare = 0; 
    519             PrivateDeclare = 0; 
    520             ExternalDeclare = 0; 
    521             strcpy(NamePrecision,""); 
    522             c_star = 0; 
    523             InitialValueGiven = 0 ; 
    524             strcpy(IntentSpec,""); 
    525             VariableIsParameter =  0 ; 
    526             Allocatabledeclare = 0 ; 
    527             Targetdeclare = 0 ; 
    528             SaveDeclare = 0; 
    529             pointerdeclare = 0; 
    530             optionaldeclare = 0 ; 
    531             dimsgiven=0; 
    532             c_selectorgiven=0; 
    533             strcpy(nameinttypename,""); 
    534             strcpy(c_selectorname,""); 
    535         } 
    536       | public 
    537         { 
    538             if (firstpass == 0) 
    539             { 
    540                 if ($1) 
    541                 { 
    542                     removeglobfromlist(&($1)); 
    543                     pos_end = setposcur(); 
    544                     RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur); 
    545                     writelistpublic($1); 
    546                 } 
    547             } 
    548         } 
    549       | private 
    550       | use_stat 
    551       | module_proc_stmt 
    552       | namelist 
    553       | TOK_BACKSPACE '(' expr ')' 
    554       | TOK_EXTERNAL opt_sep use_name_list 
    555       | TOK_INTRINSIC opt_sep use_intrinsic_list 
    556       | TOK_EQUIVALENCE list_expr_equi 
    557       | data_stmt '\n' 
    558         { 
    559             /* we should remove the data declaration                */ 
    560             pos_end = setposcur(); 
    561             RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata); 
    562  
    563             if ( aftercontainsdeclare == 1  && firstpass == 0 ) 
    564             { 
    565                 ReWriteDataStatement_0(fortran_out); 
    566                 pos_end = setposcur(); 
    567             } 
    568         } 
    569       ; 
     621 
    570622opt_spec : 
    571623      | access_spec 
     
    619671      | list_expr_equi1 ',' ident dims 
    620672      ; 
    621 list_expr : 
     673list_expr: 
    622674                      expr 
    623675      | list_expr ',' expr 
    624676      ; 
    625 opt_sep : 
     677opt_sep: 
    626678      | TOK_FOURDOTS 
    627679      ; 
    628 after_type : 
    629         dcl nodimsgiven 
    630         { 
    631             /* if the variable is a parameter we can suppose that is*/ 
    632             /*    value is the same on each grid. It is not useless */ 
    633             /*    to create a copy of it on each grid               */ 
    634             if ( ! inside_type_declare ) 
    635             { 
    636                 pos_end = setposcur(); 
    637                 RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl); 
    638                 ReWriteDeclarationAndAddTosubroutine_01($1); 
    639                 pos_cur_decl = setposcur(); 
    640                 if ( firstpass == 0 && GlobalDeclaration == 0 
    641                                     && insubroutinedeclare == 0 ) 
    642                 { 
    643                     fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename); 
    644                     sprintf(ligne, "Module_Declar_%s.h", curmodulename); 
    645                     module_declar = open_for_write(ligne); 
    646                     GlobalDeclaration = 1 ; 
    647                     pos_cur_decl = setposcur(); 
    648                 } 
    649                 $$ = $1; 
    650  
    651                 if ( firstpass ) 
    652                 { 
    653                     Add_Globliste_1($1); 
    654                     if ( insubroutinedeclare ) 
    655                     { 
    656                         if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1); 
    657                         Add_Parameter_Var_1($1); 
    658                     } 
    659                     else 
    660                         Add_GlobalParameter_Var_1($1); 
    661  
    662                     /* If there's a SAVE declaration in module's subroutines we should    */ 
    663                     /*    remove it from the subroutines declaration and add it in the    */ 
    664                     /*    global declarations                                             */ 
    665                     if ( aftercontainsdeclare && SaveDeclare ) 
    666                     { 
    667                         if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1); 
    668                         else                Add_Save_Var_dcl_1($1); 
    669                     } 
    670                 } 
    671             } 
    672             else 
    673             { 
    674                 $$ = (listvar *) NULL; 
    675             } 
    676             PublicDeclare = 0; 
    677             PrivateDeclare = 0; 
    678             ExternalDeclare = 0; 
    679             strcpy(NamePrecision,""); 
    680             c_star = 0; 
    681             InitialValueGiven = 0 ; 
    682             strcpy(IntentSpec,""); 
    683             VariableIsParameter =  0 ; 
    684             Allocatabledeclare = 0 ; 
    685             Targetdeclare = 0 ; 
    686             SaveDeclare = 0; 
    687             pointerdeclare = 0; 
    688             optionaldeclare = 0 ; 
    689             dimsgiven=0; 
    690             c_selectorgiven=0; 
    691             strcpy(nameinttypename,""); 
    692             strcpy(c_selectorname,""); 
    693             GlobalDeclarationType = 0; 
    694         } 
    695       | before_function name_routine arglist 
    696         { 
    697             insubroutinedeclare = 1; 
    698  
    699             if ( firstpass ) 
    700             { 
    701                 Add_SubroutineArgument_Var_1($3); 
    702                 Add_FunctionType_Var_1($2); 
    703             } 
    704             else 
    705                 WriteBeginof_SubLoop(); 
    706  
    707             strcpy(nameinttypename,""); 
    708         } 
    709       ; 
     680 
    710681before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; } 
    711682      ; 
    712 before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; } 
     683before_parameter :  TOK_PARAMETER   {VariableIsParameter = 1; pos_curparameter = setposcur()-9; } 
    713684      ; 
    714685 
     
    750721      ; 
    751722 
    752 save :  before_save varsave 
     723save:  before_save varsave 
    753724      | before_save comblock varsave 
    754725      | save opt_comma comblock opt_comma varsave 
    755726      | save ',' varsave 
    756727      ; 
    757 before_save : 
     728before_save: 
    758729        TOK_SAVE        { pos_cursave = setposcur()-4; } 
    759730      ; 
     
    896867            strcpy(curvar->v_subroutinename,subroutinename); 
    897868            strcpy(curvar->v_modulename,curmodulename); 
    898             strcpy(curvar->v_initialvalue,$3); 
     869            curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0); 
    899870            strcpy(curvar->v_commoninfile,cur_filename); 
    900871            Save_Length($3,14); 
     
    919890            } 
    920891        } 
    921       | TOK_IMPLICIT TOK_REAL8 
    922       ; 
    923 dcl :   options TOK_NAME dims lengspec initial_value 
     892      ; 
     893dcl:   options TOK_NAME dims lengspec initial_value 
    924894        { 
    925895            if ( ! inside_type_declare ) 
     
    970940nodimsgiven : { dimsgiven = 0; } 
    971941      ; 
    972 type :  typespec selector               { strcpy(DeclType,$1);  } 
     942type:  typespec selector               { strcpy(DeclType,$1);} 
    973943      | before_character c_selector     { strcpy(DeclType,"character");  } 
    974944      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  } 
     
    993963      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; } 
    994964      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; } 
    995       | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); } 
     965      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); printf("OK1\n");} 
    996966      ; 
    997967lengspec : 
     
    10331003      | ',' TOK_NAME clause 
    10341004      ; 
    1035 options : 
     1005options: 
    10361006      | TOK_FOURDOTS 
    10371007      | ',' attr_spec_list TOK_FOURDOTS 
    10381008      ; 
    1039 attr_spec_list : attr_spec 
     1009attr_spec_list: attr_spec 
    10401010      | attr_spec_list ',' attr_spec 
    10411011      ; 
     
    10471017      | TOK_EXTERNAL        { ExternalDeclare = 1; } 
    10481018      | TOK_INTENT '(' intent_spec ')' 
    1049                             { strcpy(IntentSpec,$3); } 
     1019                            { strcpy(IntentSpec,$3); intent_spec = 0;} 
    10501020      | TOK_INTRINSIC 
    10511021      | TOK_OPTIONAL        { optionaldeclare = 1 ; } 
     
    10641034      ; 
    10651035dims :  { $$ = (listdim*) NULL; } 
    1066       | '(' dimlist ')' 
     1036      | '(' {in_complex_literal=0;} dimlist ')' 
    10671037        { 
    10681038            $$ = (listdim*) NULL; 
    10691039            if ( inside_type_declare ) break; 
    1070             if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2; 
     1040            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$3; 
    10711041        } 
    10721042      ; 
     
    10951065      | expr                { strcpy($$,$1);  } 
    10961066      ; 
    1097 expr :  uexpr               { strcpy($$,$1); } 
     1067/* 
     1068expr:  uexpr               { strcpy($$,$1); } 
    10981069      | complex_const       { strcpy($$,$1); } 
    10991070      | predefinedfunction  { strcpy($$,$1); } 
    11001071      | '(' expr ')'        { sprintf($$,"(%s)",$2); } 
    11011072      ; 
    1102  
     1073*/ 
    11031074predefinedfunction : 
    11041075        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);} 
     
    11341105uexpr : lhs                     { strcpy($$,$1); } 
    11351106      | simple_const            { strcpy($$,$1); } 
    1136       | vec                     { strcpy($$,$1); } 
    11371107      | expr operation          { sprintf($$,"%s%s",$1,$2); } 
    11381108      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); } 
     
    11951165        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   } 
    11961166      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); } 
    1197       | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); } 
    1198       | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); } 
    1199       ; 
    1200 begin_array : 
    1201         ident '(' funarglist ')' 
     1167      | structure_component '(' {in_complex_literal=0;} funarglist ')'              { sprintf($$," %s ( %s )",$1,$4); } 
     1168      | structure_component '(' {in_complex_literal=0;} funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$4,$6); } 
     1169      ; 
     1170begin_array : TOK_LOGICALIF 
     1171      |  ident '(' {in_complex_literal=0;} funarglist ')' 
    12021172        { 
    12031173            if ( inside_type_declare ) break; 
    1204             sprintf($$," %s ( %s )",$1,$3); 
    1205             ModifyTheAgrifFunction_0($3); 
     1174            sprintf($$," %s ( %s )",$1,$4); 
     1175            ModifyTheAgrifFunction_0($4); 
    12061176            agrif_parentcall = 0; 
    12071177        } 
     
    12141184        } 
    12151185      ; 
     1186/* 
    12161187vec : 
    12171188        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); } 
    12181189      ; 
     1190*/ 
    12191191funarglist : 
    12201192        beforefunctionuse           { strcpy($$," "); } 
     
    12381210      | ':'                     {  sprintf($$,":");} 
    12391211      ; 
    1240 ident : TOK_NAME 
    1241         { 
     1212ident: TOK_NAME 
     1213        { 
     1214       //  if (indeclaration == 1) break; 
    12421215            if ( afterpercent == 0 ) 
    12431216            { 
     
    13031276      | substring   { strcpy($$,$1);} 
    13041277      ; 
     1278/* 
    13051279substring : 
    13061280        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);} 
    13071281      ; 
     1282*/ 
    13081283optexpr :           { strcpy($$," ");} 
    13091284      | expr        { strcpy($$,$1);} 
    13101285      ; 
    1311 opt_expr : 
    1312         '\n'        { strcpy($$," ");} 
     1286opt_expr :          { strcpy($$," ");} 
    13131287      | expr        { strcpy($$,$1);} 
    13141288      ; 
    1315 initial_value :     { InitialValueGiven = 0; } 
     1289initial_value:     { InitialValueGiven = 0; } 
    13161290      | '=' expr 
    13171291        { 
     
    13301304        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); } 
    13311305      ; 
    1332 use_stat : 
    1333         word_use TOK_NAME 
    1334         { 
    1335             /* if variables has been declared in a subroutine       */ 
    1336             sprintf(charusemodule, "%s", $2); 
    1337             if ( firstpass ) 
    1338             { 
    1339                 Add_NameOfModuleUsed_1($2); 
     1306 
     1307only_list : 
     1308        only_name   {  $$ = $1; } 
     1309      | only_list ',' only_name 
     1310        { 
     1311            /* insert the variable in the list $1                 */ 
     1312            $3->suiv = $1; 
     1313            $$ = $3; 
     1314        } 
     1315      ; 
     1316only_name : 
     1317        TOK_NAME TOK_POINT_TO TOK_NAME 
     1318        { 
     1319            coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); 
     1320            strcpy(coupletmp->c_namevar,$1); 
     1321            strcpy(coupletmp->c_namepointedvar,$3); 
     1322            coupletmp->suiv = NULL; 
     1323            $$ = coupletmp; 
     1324            pointedvar = 1; 
     1325            Add_UsedInSubroutine_Var_1($1); 
     1326        } 
     1327      | TOK_NAME 
     1328        { 
     1329            coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); 
     1330            strcpy(coupletmp->c_namevar,$1); 
     1331            strcpy(coupletmp->c_namepointedvar,""); 
     1332            coupletmp->suiv = NULL; 
     1333            $$ = coupletmp; 
     1334        } 
     1335      ; 
     1336 
     1337/* R204 : specification-part */ 
     1338/* opt-implicit-part removed but implicit-stmt and format-stmt added to declaration-construct */ 
     1339specification-part: opt-use-stmt-list opt-declaration-construct-list 
     1340     ; 
     1341 
     1342opt-use-stmt-list: 
     1343     |use-stmt-list 
     1344     ; 
     1345      
     1346opt-implicit-part: 
     1347     |implicit-part 
     1348     ; 
     1349 
     1350implicit-part: opt-implicit-part-stmt-list implicit-stmt 
     1351     ; 
     1352      
     1353opt-implicit-part-stmt-list: 
     1354     | implicit-part-stmt-list 
     1355     ; 
     1356      
     1357implicit-part-stmt-list: implicit-part-stmt 
     1358     | implicit-part-stmt-list implicit-part-stmt 
     1359     ; 
     1360      
     1361/* R206: implicit-part-stmt */ 
     1362implicit-part-stmt: implicit-stmt 
     1363     | parameter-stmt 
     1364     | format-stmt 
     1365     ; 
     1366 
     1367 
     1368opt-declaration-construct-list: 
     1369     |declaration-construct-list 
     1370     ; 
     1371      
     1372declaration-construct-list: 
     1373        declaration-construct 
     1374      | declaration-construct-list declaration-construct 
     1375      ; 
     1376      
     1377/* R207 : declaration-construct */ 
     1378/* stmt-function-stmt replaced by assignment-stmt due to reduce conflicts */ 
     1379/* because assignment-stmt has been added  */ 
     1380/* Every statement that begins with a variable should be added */ 
     1381/* This include : */ 
     1382/* pointer-assignment-stmt, do-construct */ 
     1383/* implicit-stmt and format-stmt added since implicit-part-stmt has been removed due to conflicts (see R204) */ 
     1384/* ANOTHER SOLUTION TO THE PROBLEM OF STMT-FUNCTION IS NEEDED !!!! */ 
     1385/* BECAUSE ALMOST ALL ACTION-STMT SHOULD BE INCLUDED HERE !!! */ 
     1386 
     1387declaration-construct: derived-type-def 
     1388     | parameter-stmt 
     1389     | format-stmt 
     1390     | implicit-stmt 
     1391     | other-specification-stmt 
     1392     | type-declaration-stmt 
     1393     | assignment-stmt 
     1394     | pointer-assignment-stmt 
     1395     | do-construct 
     1396     | if-construct 
     1397     | continue-stmt 
     1398     | return-stmt 
     1399     | print-stmt 
     1400     ; 
     1401 
     1402opt-execution-part: 
     1403     | execution-part 
     1404     ; 
     1405 
     1406/* R208 : execution-part */ 
     1407execution-part: executable-construct opt-execution-part-construct-list 
     1408     ; 
     1409 
     1410opt-execution-part-construct-list: 
     1411     |execution-part-construct-list 
     1412     ; 
     1413 
     1414execution-part-construct-list: 
     1415        execution-part-construct 
     1416      | execution-part-construct-list execution-part-construct 
     1417      ; 
     1418 
     1419/* R209 : execution-part-construct */ 
     1420execution-part-construct: executable-construct 
     1421      | format-stmt 
     1422      ; 
     1423 
     1424opt-internal-subprogram-part: 
     1425     | internal-subprogram-part 
     1426     ; 
     1427      
     1428/* R120 : internal-subprogram-part */ 
     1429internal-subprogram-part: TOK_CONTAINS line-break 
     1430      opt-internal-subprogram 
     1431     ; 
     1432 
     1433opt-internal-subprogram: 
     1434     | internal-subprogram-list 
     1435     ; 
     1436 
     1437internal-subprogram-list: internal-subprogram 
     1438     | internal-subprogram-list internal-subprogram 
     1439     ; 
     1440 
     1441/* R211 : internal-subprogram */ 
     1442internal-subprogram: function-subprogram 
     1443     | subroutine-subprogram 
     1444     ; 
     1445 
     1446/* R212 : other-specification-stmt */ 
     1447other-specification-stmt: access-stmt 
     1448     | common-stmt 
     1449     | data-stmt 
     1450     | dimension-stmt 
     1451     | equivalence-stmt 
     1452     | external-stmt 
     1453     | intrinsic-stmt 
     1454     | namelist-stmt 
     1455     | save-stmt 
     1456     ; 
     1457 
     1458/* R213 : executable-construct */ 
     1459executable-construct: 
     1460        action-stmt 
     1461      | do-construct 
     1462      | case-construct 
     1463      | if-construct 
     1464      | where-construct 
     1465      ; 
     1466 
     1467/* R214 : action-stmt */ 
     1468 
     1469/* normal action-stmt */ 
     1470 
     1471action-stmt: 
     1472      allocate-stmt 
     1473      | assignment-stmt 
     1474      | call-stmt 
     1475      | close-stmt 
     1476      | continue-stmt 
     1477      | cycle-stmt 
     1478      | deallocate-stmt 
     1479      | goto-stmt 
     1480      | exit-stmt 
     1481      | flush-stmt 
     1482      | TOK_CYCLE opt_expr 
     1483      | TOK_NULLIFY '(' pointer_name_list ')' 
     1484      | TOK_ENDMODULE opt_name 
     1485        { 
     1486            /* if we never meet the contains keyword               */ 
     1487            if ( firstpass == 0 ) 
     1488            { 
     1489                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module" 
     1490                if ( inmoduledeclare && ! aftercontainsdeclare ) 
     1491                { 
     1492                    Write_Closing_Module(1); 
     1493                } 
     1494                fprintf(fortran_out,"\n      end module %s\n", curmodulename); 
     1495                if ( module_declar && insubroutinedeclare == 0 ) 
     1496                { 
     1497                    fclose(module_declar); 
     1498                } 
     1499            } 
     1500            inmoduledeclare = 0 ; 
     1501            inmodulemeet = 0 ; 
     1502            aftercontainsdeclare = 1; 
     1503            strcpy(curmodulename, ""); 
     1504            GlobalDeclaration = 0 ; 
     1505        } 
     1506      | if-stmt 
     1507      | inquire-stmt 
     1508      | open-stmt 
     1509      | pointer-assignment-stmt 
     1510      | print-stmt 
     1511      | read-stmt 
     1512      | return-stmt 
     1513      | rewind-stmt 
     1514      | stop-stmt 
     1515      | where-stmt 
     1516      | write-stmt 
     1517      | arithmetic-if-stmt 
     1518      ; 
     1519 
     1520/* R215 : keyword */ 
     1521keyword: ident 
     1522     ; 
     1523 
     1524scalar-constant: constant 
     1525    ; 
     1526 
     1527/* R304 : constant */ 
     1528 
     1529constant: literal-constant 
     1530     | named-constant 
     1531     ; 
     1532      
     1533/* R305 : literal-constant */ 
     1534literal-constant: int-literal-constant 
     1535     | real-literal-constant 
     1536     | logical-literal-constant 
     1537     | complex-literal-constant 
     1538     {in_complex_literal=0;} 
     1539     | char-literal-constant 
     1540     ; 
     1541      
     1542/* R306 : named-constant */ 
     1543named-constant: ident 
     1544     ; 
     1545 
     1546scalar-int-constant:int-constant 
     1547     ; 
     1548 
     1549/* R307 : int-constant */ 
     1550int-constant: int-literal-constant 
     1551     | named-constant 
     1552     ; 
     1553      
     1554/* 
     1555constant: TOK_CSTINT 
     1556     | TOK_CSTREAL 
     1557     | ident 
     1558     ; 
     1559*/ 
     1560 
     1561opt-label: 
     1562     {strcpy($$,"");} 
     1563     | label 
     1564     ; 
     1565 
     1566/* R312 : label */ 
     1567label: TOK_LABEL 
     1568     | TOK_CSTINT 
     1569     ; 
     1570 
     1571opt-label-djview: 
     1572     {strcpy($$,"");} 
     1573     | label-djview 
     1574     {strcpy($$,$1);} 
     1575     ; 
     1576      
     1577label-djview: TOK_LABEL_DJVIEW 
     1578     ; 
     1579 
     1580/* R401 : type-param-value */ 
     1581type-param-value: scalar-int-expr 
     1582     | '*' 
     1583     | ':' 
     1584     ; 
     1585 
     1586/* R402: type-spec */ 
     1587type-spec: intrinsic-type-spec 
     1588     {strcpy($$,$1);} 
     1589     | derived-type-spec 
     1590     {strcpy($$,$1);} 
     1591     ; 
     1592 
     1593/* R403 : declaration-type-spec */ 
     1594declaration-type-spec: {pos_cur_decl=my_position_before;} intrinsic-type-spec 
     1595     {strcpy($$,$2);} 
     1596     | TOK_TYPEPAR intrinsic-type-spec ')' 
     1597     | TOK_TYPEPAR derived-type-spec ')' 
     1598     {strcpy(DeclType,"type"); GlobalDeclarationType = 1;  } 
     1599     ; 
     1600 
     1601/* R404 : intrinsic-type-spec */ 
     1602intrinsic-type-spec: TOK_INTEGER {in_kind_selector = 1;} opt-kind-selector 
     1603     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1); in_kind_selector =0;} 
     1604     | TOK_REAL {in_kind_selector = 1;} opt-kind-selector 
     1605     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} 
     1606     | TOK_DOUBLEPRECISION {in_kind_selector = 1;} opt-kind-selector 
     1607     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,"real"); strcpy(NamePrecision,"8");in_kind_selector =0;} 
     1608     | TOK_COMPLEX {in_kind_selector = 1;} opt-kind-selector 
     1609     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} 
     1610     | TOK_CHARACTER {in_char_selector = 1;} opt-char-selector 
     1611     {sprintf($$,"%s%s",$1,$[opt-char-selector]);strcpy(DeclType,$1);in_char_selector = 0;} 
     1612     | TOK_LOGICAL {in_kind_selector = 1;} opt-kind-selector 
     1613     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} 
     1614     ; 
     1615 
     1616opt-kind-selector: 
     1617     {strcpy($$,"");strcpy(NamePrecision,"");} 
     1618     |kind-selector 
     1619     {strcpy($$,$1);} 
     1620     ; 
     1621      
     1622/* R405 : kind-selector */ 
     1623/* Nonstandard extension : * INT */ 
     1624kind-selector: '(' scalar-int-constant-expr ')' 
     1625     {sprintf($$,"(%s)",$2); strcpy(NamePrecision,$2);} 
     1626     | '(' TOK_KIND '=' scalar-int-constant-expr ')' 
     1627     {sprintf($$,"(KIND=%s)",$4); strcpy(NamePrecision,$4);} 
     1628     | '*' TOK_CSTINT 
     1629     {sprintf($$,"*%s",$2);strcpy(NamePrecision,$2);} 
     1630     ; 
     1631 
     1632/* R406 : signed-int-literal-constant */ 
     1633/* sign replaced by add-op */ 
     1634 
     1635signed-int-literal-constant:int-literal-constant 
     1636     | add-op int-literal-constant 
     1637     {sprintf($$,"%s%s",$1,$2);} 
     1638     ; 
     1639      
     1640/* R407 : int-literal-constant */ 
     1641int-literal-constant: TOK_CSTINT 
     1642     | TOK_CSTINT '_' kind-param 
     1643     {sprintf($$,"%s_%s",$1,$3);} 
     1644     ; 
     1645 
     1646/*R408 : kind-param */ 
     1647kind-param: TOK_CSTINT 
     1648     | TOK_NAME 
     1649     ; 
     1650 
     1651opt-sign: 
     1652     | sign 
     1653     ; 
     1654 
     1655/* R411 : sign */ 
     1656sign:'+' 
     1657     {strcpy($$,"+");} 
     1658     | '-' 
     1659     {strcpy($$,"-");} 
     1660     ; 
     1661 
     1662/* R412 : signed-real-literal-constant */ 
     1663/* sign replaced by add-op */ 
     1664signed-real-literal-constant:real-literal-constant 
     1665     | add-op real-literal-constant 
     1666     {sprintf($$,"%s%s",$1,$2);} 
     1667     ; 
     1668 
     1669/* R413 : real-literal-constant */ 
     1670real-literal-constant: TOK_CSTREAL 
     1671     | TOK_CSTREAL '_' kind-param 
     1672     {sprintf($$,"%s_%s",$1,$3);}; 
     1673     ; 
     1674 
     1675/* R417 : complex-literal-constant */ 
     1676/* in-complex-literal is just here to change default precedence rules ... */ 
     1677 
     1678complex-literal-constant: '(' real-part TOK_COMMACOMPLEX imag-part ')' 
     1679     {sprintf($$,"(%s,%s)",$2,$4);} 
     1680     ; 
     1681 
     1682 
     1683/* R418 : real-part */ 
     1684real-part: signed-int-literal-constant 
     1685     | signed-real-literal-constant 
     1686     | ident 
     1687     ; 
     1688 
     1689/* R419 : imag-part */ 
     1690imag-part: signed-int-literal-constant 
     1691     | signed-real-literal-constant 
     1692     | named-constant 
     1693     ; 
     1694 
     1695opt-char_length-star: 
     1696     | '*' char-length 
     1697     {char_length_toreset = 1;} 
     1698     ; 
     1699 
     1700opt-char-selector: 
     1701     {strcpy($$,"");} 
     1702    | char-selector 
     1703    {strcpy($$,"");} 
     1704    ; 
     1705 
     1706/* R420 : char-selector */ 
     1707char-selector:length-selector 
     1708    | '(' TOK_LEN '=' type-param-value ',' TOK_KIND '=' scalar-int-constant-expr ')' 
     1709    | '(' type-param-value ',' scalar-int-constant-expr ')' 
     1710    | '(' TOK_KIND '=' scalar-int-constant-expr ')' 
     1711    | '(' TOK_KIND '=' scalar-int-constant-expr ',' TOK_LEN '=' type-param-value ')' 
     1712    ; 
     1713 
     1714/* R421 : length-selector */ 
     1715length-selector: '(' type-param-value ')' 
     1716     {strcpy(CharacterSize,$2);} 
     1717     | '(' TOK_LEN '=' type-param-value ')' 
     1718     {strcpy(CharacterSize,$4);} 
     1719     | '*' char-length 
     1720     | '*' char-length ',' 
     1721     ; 
     1722 
     1723/* R422 : char-length */ 
     1724char-length: '(' type-param-value ')' 
     1725     {c_star=1; strcpy(CharacterSize,$2);} 
     1726     | int-literal-constant 
     1727     {c_selectorgiven = 1; strcpy(c_selectorname,$1);} 
     1728     ; 
     1729 
     1730/* R423 : char-literal-constant */ 
     1731char-literal-constant: TOK_CHAR_CONSTANT 
     1732     | TOK_CHAR_MESSAGE 
     1733     | TOK_CHAR_CUT 
     1734     ; 
     1735 
     1736/* R424 : logical-literal-constant */ 
     1737logical-literal-constant: TOK_TRUE 
     1738     | TOK_FALSE 
     1739     ; 
     1740 
     1741/* R425 : derived-type-def */ 
     1742derived-type-def: derived-type-stmt { inside_type_declare = 1;} opt-component-part end-type-stmt 
     1743     { inside_type_declare = 0;} 
     1744     ; 
     1745      
     1746/* R426 : derived-type-stmt */ 
     1747derived-type-stmt: TOK_TYPE opt-type-attr-spec-list-comma-fourdots TOK_NAME line-break 
     1748     | TOK_TYPE opt-type-attr-spec-list-comma TOK_NAME '(' type-param-name-list ')' line-break 
     1749     ; 
     1750 
     1751opt-type-attr-spec-list-comma-fourdots: 
     1752    | opt-type-attr-spec-list-comma TOK_FOURDOTS 
     1753    ; 
     1754  
     1755 opt-type-attr-spec-list-comma: 
     1756     | ',' type-attr-spec-list 
     1757     ; 
     1758 
     1759type-attr-spec-list: type-attr-spec 
     1760     | type-attr-spec-list ',' type-attr-spec 
     1761     ; 
     1762 
     1763/* R427 : type-attr-spec */ 
     1764type-attr-spec: access-spec 
     1765     ; 
     1766 
     1767type-param-name-list: type-param-name 
     1768     | type-param-name-list ',' type-param-name 
     1769     ; 
     1770      
     1771type-param-name: TOK_NAME 
     1772     ; 
     1773 
     1774/* R429 : end-type-stmt */ 
     1775end-type-stmt: TOK_ENDTYPE line-break 
     1776     | TOK_ENDTYPE TOK_NAME line-break 
     1777     ; 
     1778 
     1779opt-component-part: 
     1780     | component-part 
     1781     ; 
     1782 
     1783/* R434 : component-part */ 
     1784component-part: component-def-stmt 
     1785    | component-part component-def-stmt 
     1786    ; 
     1787 
     1788/* R435 : component-def-stmt */ 
     1789component-def-stmt: data-component-def-stmt 
     1790    ; 
     1791     
     1792/* R436 : data-component-def-stmt */ 
     1793data-component-def-stmt: declaration-type-spec opt-component-attr-spec-list-comma-2points component-decl-list line-break 
     1794     ; 
     1795 
     1796opt-component-attr-spec-list-comma-2points: 
     1797     | TOK_FOURDOTS 
     1798     | ',' component-attr-spec-list TOK_FOURDOTS 
     1799     ; 
     1800 
     1801component-attr-spec-list: component-attr-spec 
     1802     | component-attr-spec-list ',' component-attr-spec 
     1803     ; 
     1804      
     1805/* R437 : component-attr-spec */ 
     1806component-attr-spec: access-spec 
     1807     | TOK_ALLOCATABLE 
     1808     | TOK_DIMENSION '(' {in_complex_literal=0;} component-array-spec ')' 
     1809     | TOK_POINTER 
     1810     ; 
     1811 
     1812component-decl-list: component-decl 
     1813     | component-decl-list ',' component-decl 
     1814     ; 
     1815 
     1816/* R438 : component-decl */ 
     1817component-decl : ident opt-component-array-spec opt-char_length-star opt-component-initialization 
     1818       { 
     1819            PublicDeclare = 0; 
     1820            PrivateDeclare = 0; 
     1821            ExternalDeclare = 0; 
     1822            strcpy(NamePrecision,""); 
     1823            c_star = 0; 
     1824            InitialValueGiven = 0 ; 
     1825            strcpy(IntentSpec,""); 
     1826            VariableIsParameter =  0 ; 
     1827            Allocatabledeclare = 0 ; 
     1828            Targetdeclare = 0 ; 
     1829            SaveDeclare = 0; 
     1830            pointerdeclare = 0; 
     1831            optionaldeclare = 0 ; 
     1832            dimsgiven=0; 
     1833            c_selectorgiven=0; 
     1834            strcpy(nameinttypename,""); 
     1835            strcpy(c_selectorname,""); 
     1836            GlobalDeclarationType = 0; 
     1837         } 
     1838     ; 
     1839 
     1840opt-component-array-spec: 
     1841     | '(' component-array-spec ')' 
     1842     ; 
     1843 
     1844/* R439 : component-array-spec */ 
     1845component-array-spec: explicit-shape-spec-list 
     1846     | deferred-shape-spec-list 
     1847     ; 
     1848 
     1849opt-component-initialization: 
     1850     | component-initialization 
     1851     ; 
     1852      
     1853/* R442 : component-initialization */ 
     1854component-initialization: '=' constant-expr 
     1855      | TOK_POINT_TO null-init 
     1856      | TOK_POINT_TO initial-data-target 
     1857      ; 
     1858 
     1859/* R443 initial-data-target */ 
     1860initial-data-target: designator 
     1861     {strcpy(my_dim.last,"");} 
     1862     ; 
     1863 
     1864/* R453 : derived-type-spec */ 
     1865derived-type-spec: ident  
     1866     {strcpy(NamePrecision,$1);} 
     1867     | ident '(' type-param-spec-list ')' 
     1868     ; 
     1869      
     1870type-param-spec-list: type-param-spec 
     1871     | type-param-spec-list ',' type-param-spec 
     1872     ; 
     1873 
     1874/* R454 : type-param-spec */ 
     1875type-param-spec: type-param-value 
     1876    | keyword '=' type-param-value 
     1877    ; 
     1878 
     1879/* R455 : structure-constructor */ 
     1880structure-constructor: derived-type-spec '(' ')' 
     1881     | derived-type-spec '(' component-spec-list ')' 
     1882     ; 
     1883      
     1884component-spec-list: component-spec 
     1885     | component-spec-list ',' component-spec 
     1886     ; 
     1887      
     1888/* R456 : component-spec */ 
     1889component-spec: component-data-source 
     1890     | keyword '=' component-data-source 
     1891     ; 
     1892 
     1893/* R457 : component-data-source */ 
     1894component-data-source: expr 
     1895     | data-target 
     1896     | proc-target 
     1897     ; 
     1898 
     1899/* R468 : array-constructor */ 
     1900array-constructor: TOK_LEFTAB ac-spec TOK_RIGHTAB 
     1901     { sprintf($$,"(/%s/)",$2);} 
     1902     | lbracket ac-spec rbracket 
     1903     { sprintf($$,"[%s]",$2); } 
     1904     ; 
     1905      
     1906/* R469 : ac-spec */ 
     1907/* type-spec TOK_FOURDOTS is removed due to conflicts with part-ref */ 
     1908 
     1909/*ac-spec: type-spec TOK_FOURDOTS 
     1910     {sprintf($$,"%s::",$1);} 
     1911     | ac-value-list 
     1912     | type-spec TOK_FOURDOTS ac-value-list 
     1913     {sprintf($$,"%s::%s",$1,$3);} 
     1914     ; 
     1915*/ 
     1916 
     1917ac-spec: ac-value-list 
     1918     ; 
     1919      
     1920/* R470 : lbracket */ 
     1921lbracket: '[' 
     1922     ; 
     1923 
     1924/* R471 : rbracket */ 
     1925rbracket: ']' 
     1926     ; 
     1927 
     1928ac-value-list: 
     1929        ac-value 
     1930      | ac-value-list ',' ac-value 
     1931      {sprintf($$,"%s,%s",$1,$3);} 
     1932      ; 
     1933 
     1934/* R472 : ac-value */ 
     1935ac-value: expr 
     1936      | ac-implied-do 
     1937      ; 
     1938 
     1939/* R473 : ac-implied-do */ 
     1940ac-implied-do: '(' ac-value-list ',' ac-implied-do-control ')' 
     1941     {sprintf($$,"(%s,%s)",$2,$4);} 
     1942     ; 
     1943 
     1944/* R474 : ac-implied-do-control */ 
     1945ac-implied-do-control: ac-do-variable '=' scalar-int-expr ',' scalar-int-expr 
     1946     {sprintf($$,"%s=%s,%s",$1,$3,$5);} 
     1947     | ac-do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr 
     1948     {sprintf($$,"%s=%s,%s,%s",$1,$3,$5,$7);} 
     1949     ; 
     1950 
     1951/* R475 : ac-do-variable */ 
     1952ac-do-variable: do-variable 
     1953     ; 
     1954 
     1955/* R501 : type-declaration-stmt */ 
     1956type-declaration-stmt: {indeclaration=1;} declaration-type-spec opt-attr-spec-construct entity-decl-list 
     1957        { 
     1958            /* if the variable is a parameter we can suppose that is*/ 
     1959            /*    value is the same on each grid. It is not useless */ 
     1960            /*    to create a copy of it on each grid               */ 
     1961            if ( ! inside_type_declare ) 
     1962            { 
     1963                pos_end = setposcur(); 
     1964                //printf("POS = %d %d\n",pos_cur_decl,pos_end); 
     1965                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl); 
     1966                ReWriteDeclarationAndAddTosubroutine_01($[entity-decl-list]); 
     1967                pos_cur_decl = setposcur(); 
     1968                if ( firstpass == 0 && GlobalDeclaration == 0 
     1969                                    && insubroutinedeclare == 0 ) 
     1970                { 
     1971                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename); 
     1972                    sprintf(ligne, "Module_Declar_%s.h", curmodulename); 
     1973                    module_declar = open_for_write(ligne); 
     1974                    GlobalDeclaration = 1 ; 
     1975                    pos_cur_decl = setposcur(); 
     1976                } 
     1977 
     1978                if ( firstpass ) 
     1979                { 
     1980                    Add_Globliste_1($[entity-decl-list]); 
     1981                    if ( insubroutinedeclare ) 
     1982                    { 
     1983                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($[entity-decl-list]); 
     1984                        Add_Parameter_Var_1($[entity-decl-list]); 
     1985                    } 
     1986                    else 
     1987                        Add_GlobalParameter_Var_1($[entity-decl-list]); 
     1988 
     1989                    /* If there's a SAVE declaration in module's subroutines we should    */ 
     1990                    /*    remove it from the subroutines declaration and add it in the    */ 
     1991                    /*    global declarations                                             */ 
     1992                                         
     1993                    if ( aftercontainsdeclare && SaveDeclare ) 
     1994                    { 
     1995                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($[entity-decl-list]); 
     1996                        else                Add_Save_Var_dcl_1($[entity-decl-list]); 
     1997                    } 
     1998                } 
     1999            } 
     2000            indeclaration = 0; 
     2001            PublicDeclare = 0; 
     2002            PrivateDeclare = 0; 
     2003            ExternalDeclare = 0; 
     2004            strcpy(NamePrecision,""); 
     2005            c_star = 0; 
     2006            InitialValueGiven = 0 ; 
     2007            strcpy(IntentSpec,""); 
     2008            VariableIsParameter =  0 ; 
     2009            Allocatabledeclare = 0 ; 
     2010            Targetdeclare = 0 ; 
     2011            SaveDeclare = 0; 
     2012            pointerdeclare = 0; 
     2013            optionaldeclare = 0 ; 
     2014            dimsgiven=0; 
     2015            c_selectorgiven=0; 
     2016            strcpy(nameinttypename,""); 
     2017            strcpy(c_selectorname,""); 
     2018            strcpy(DeclType,""); 
     2019            GlobalDeclarationType = 0; 
     2020        } 
     2021     line-break 
     2022     ; 
     2023 
     2024opt-attr-spec-construct: 
     2025     | opt-attr-spec-comma-list TOK_FOURDOTS 
     2026     ; 
     2027 
     2028opt-attr-spec-comma-list: 
     2029     | attr-spec-comma-list 
     2030     ; 
     2031      
     2032attr-spec-comma-list: 
     2033        ',' attr-spec 
     2034      | attr-spec-comma-list ',' attr-spec 
     2035      ; 
     2036 
     2037/* R502 : attr-spec */ 
     2038attr-spec:access-spec 
     2039     | TOK_ALLOCATABLE 
     2040     { Allocatabledeclare = 1; } 
     2041     | TOK_DIMENSION '(' {in_complex_literal=0;} array-spec ')' 
     2042     { dimsgiven = 1; curdim = $4; } 
     2043     | TOK_EXTERNAL 
     2044     { ExternalDeclare = 1; } 
     2045     | TOK_INTENT '(' {in_complex_literal=0;} intent-spec ')' 
     2046     { strcpy(IntentSpec,$4); } 
     2047     | TOK_INTRINSIC 
     2048     | TOK_OPTIONAL 
     2049     { optionaldeclare = 1 ; } 
     2050     | TOK_PARAMETER 
     2051     {VariableIsParameter = 1; } 
     2052     | TOK_POINTER 
     2053     { pointerdeclare = 1 ; } 
     2054     | TOK_SAVE 
     2055     { SaveDeclare = 1 ; } 
     2056     | TOK_TARGET 
     2057     { Targetdeclare = 1; } 
     2058     ; 
     2059 
     2060 
     2061entity-decl-list: entity-decl 
     2062     {$$=insertvar(NULL,$1);} 
     2063     | entity-decl-list ',' entity-decl 
     2064     {$$=insertvar($1,$3);} 
     2065     ; 
     2066 
     2067/* R503 : entity-decl */ 
     2068entity-decl: object-name-noident opt-array-spec-par opt-char_length-star opt-initialization 
     2069        { 
     2070            if ( ! inside_type_declare ) 
     2071            { 
     2072                if (dimsgiven == 1) curvar = createvar($1,curdim); 
     2073                else                curvar = createvar($1,$2); 
     2074                CreateAndFillin_Curvar(DeclType, curvar); 
     2075                strcpy(curvar->v_typevar,DeclType); 
     2076                curvar->v_catvar = get_cat_var(curvar); 
     2077                 
     2078                if (!strcasecmp(DeclType,"character")) 
     2079                { 
     2080                    if (c_selectorgiven == 1) 
     2081                    { 
     2082                        Save_Length(c_selectorname,1); 
     2083                        strcpy(curvar->v_dimchar,c_selectorname); 
     2084                    } 
     2085                } 
     2086            } 
     2087            strcpy(vallengspec,""); 
     2088            if (char_length_toreset == 1) 
     2089            { 
     2090            c_selectorgiven = 0; 
     2091            c_star = 0; 
     2092            strcpy(c_selectorname,""); 
     2093            strcpy(CharacterSize,""); 
     2094            char_length_toreset = 0; 
     2095            } 
     2096            $$=curvar; 
     2097        } 
     2098     ; 
     2099 
     2100 
     2101/* R504 : object-name */ 
     2102object-name: ident 
     2103     ; 
     2104 
     2105object-name-noident: TOK_NAME 
     2106     ; 
     2107 
     2108opt-initialization: {InitialValueGiven = 0; } 
     2109     | initialization 
     2110     ; 
     2111 
     2112/* R505 : initialization */ 
     2113initialization: '=' constant-expr 
     2114        { 
     2115            if ( inside_type_declare ) break; 
     2116            strcpy(InitValue,$2); 
     2117            InitialValueGiven = 1; 
     2118        } 
     2119     | TOK_POINT_TO null-init 
     2120        { 
     2121            if ( inside_type_declare ) break; 
     2122            strcpy(InitValue,$2); 
     2123            InitialValueGiven = 2; 
     2124        } 
     2125     | TOK_POINT_TO initial-data-target 
     2126        { 
     2127            if ( inside_type_declare ) break; 
     2128            strcpy(InitValue,$2); 
     2129            InitialValueGiven = 2; 
     2130        } 
     2131     ; 
     2132 
     2133/* R506 : null-init */ 
     2134null-init: function-reference 
     2135     ; 
     2136 
     2137/* R507 : access-spec */ 
     2138access-spec: TOK_PUBLIC 
     2139     {PublicDeclare = 1;  } 
     2140     | TOK_PRIVATE 
     2141     {PrivateDeclare = 1;  } 
     2142     ; 
     2143 
     2144opt-array-spec-par: 
     2145     {$$=NULL;} 
     2146     | '(' {in_complex_literal=0;} array-spec ')' 
     2147     {$$=$3;} 
     2148     ; 
     2149 
     2150/* R514 : array-spec */ 
     2151array-spec: explicit-shape-spec-list 
     2152     {$$=$1;} 
     2153     | assumed-shape-spec-list 
     2154     {$$=$1;} 
     2155     | deferred-shape-spec-list 
     2156     {$$=$1;} 
     2157     | assumed-size-spec 
     2158     {$$=$1;} 
     2159     | implied-shape-spec-list 
     2160     {$$=$1;} 
     2161     ; 
     2162 
     2163explicit-shape-spec-list: explicit-shape-spec 
     2164        { 
     2165            $$ = (listdim*) NULL; 
     2166            if ( inside_type_declare ) break; 
     2167            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1); 
     2168        } 
     2169      | explicit-shape-spec-list ',' explicit-shape-spec 
     2170        { 
     2171            $$ = (listdim*) NULL; 
     2172            if ( inside_type_declare ) break; 
     2173            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); 
     2174        } 
     2175      ; 
     2176       
     2177/* R516 : explicit-shape-spec */ 
     2178explicit-shape-spec: lower-bound ':' upper-bound 
     2179     {strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); } 
     2180     |upper-bound  
     2181     {strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1);} 
     2182     ; 
     2183      
     2184/* R517 : lower-bound */ 
     2185lower-bound: specification-expr 
     2186     {strcpy($$,$1);} 
     2187     ; 
     2188      
     2189/* R518 : upper-bound */ 
     2190upper-bound: specification-expr 
     2191     ; 
     2192 
     2193assumed-shape-spec-list: 
     2194        assumed-shape-spec 
     2195        { 
     2196            $$ = (listdim*) NULL; 
     2197            if ( inside_type_declare ) break; 
     2198            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1); 
     2199        } 
     2200      | assumed-shape-spec-list ',' assumed-shape-spec 
     2201        { 
     2202            $$ = (listdim*) NULL; 
     2203            if ( inside_type_declare ) break; 
     2204            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); 
     2205        } 
     2206      ; 
     2207 
     2208/* R519 : assumed-shape-spec */ 
     2209assumed-shape-spec : ':' 
     2210      { strcpy($$.first,"");  strcpy($$.last,"");  } 
     2211      | lower-bound ':' 
     2212      { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); } 
     2213      ; 
     2214 
     2215deferred-shape-spec-list: 
     2216        deferred-shape-spec 
     2217        { 
     2218            $$ = (listdim*) NULL; 
     2219            if ( inside_type_declare ) break; 
     2220            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1); 
     2221        } 
     2222      | deferred-shape-spec-list ',' deferred-shape-spec 
     2223        { 
     2224            $$ = (listdim*) NULL; 
     2225            if ( inside_type_declare ) break; 
     2226            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); 
     2227        } 
     2228      ; 
     2229 
     2230/* R520 : deferred-shape-spec */ 
     2231deferred-shape-spec: ':' 
     2232     { strcpy($$.first,"");  strcpy($$.last,"");  } 
     2233     ; 
     2234 
     2235/* R521 : assume-size-spec */ 
     2236assumed-size-spec:opt-explicit-shape-spec-list-comma opt-lower-bound-2points '*' 
     2237        { 
     2238            $$ = (listdim*) NULL; 
     2239            if ( inside_type_declare ) break; 
     2240            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  
     2241            { 
     2242            if (!strcasecmp($2,"")) 
     2243            { 
     2244            strcpy(my_dim.first,"1"); 
    13402245            } 
    13412246            else 
    13422247            { 
    1343                 if ( insubroutinedeclare ) 
    1344                     copyuse_0($2); 
    1345  
    1346                 if ( inmoduledeclare == 0 ) 
     2248            strcpy(my_dim.first,$2); 
     2249            } 
     2250            strcpy(my_dim.last,"*"); 
     2251            $$=insertdim($1,my_dim); 
     2252            strcpy(my_dim.first,""); 
     2253            strcpy(my_dim.last,""); 
     2254            } 
     2255        } 
     2256     ; 
     2257      
     2258opt-explicit-shape-spec-list-comma: 
     2259     {$$ = (listdim *) NULL;} 
     2260     | explicit-shape-spec-list ',' 
     2261     {$$ = $1;} 
     2262     ; 
     2263 
     2264explicit-shape-spec-list-comma: explicit-shape-spec ',' 
     2265        { 
     2266            $$ = (listdim*) NULL; 
     2267            if ( inside_type_declare ) break; 
     2268            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1); 
     2269        } 
     2270     | explicit-shape-spec-list-comma explicit-shape-spec ',' 
     2271        { 
     2272            $$ = (listdim*) NULL; 
     2273            if ( inside_type_declare ) break; 
     2274            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$2); 
     2275        } 
     2276     ; 
     2277 
     2278opt-lower-bound-2points: 
     2279     {strcpy($$,"");} 
     2280     | lower-bound ':' 
     2281     {strcpy($$,$1);} 
     2282     ; 
     2283 
     2284implied-shape-spec-list: implied-shape-spec 
     2285     | implied-shape-spec-list ',' implied-shape-spec 
     2286     ; 
     2287 
     2288/* R522 : implied-shape-spec */ 
     2289implied-shape-spec: opt-lower-bound-2points '*' 
     2290     ; 
     2291 
     2292/* R523 : intent-spec */ 
     2293intent-spec: TOK_IN 
     2294     { strcpy($$,$1); } 
     2295     | TOK_OUT 
     2296     { strcpy($$,$1); } 
     2297     | TOK_INOUT 
     2298     { strcpy($$,$1); } 
     2299     ; 
     2300 
     2301/* R524 : access-stmt */ 
     2302access-stmt: access-spec opt-access-id-list 
     2303     { 
     2304            if ((firstpass == 0) && (PublicDeclare == 1)) 
     2305            { 
     2306                if ($2) 
     2307                { 
     2308                    removeglobfromlist(&($2)); 
     2309                    pos_end = setposcur(); 
     2310                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur); 
     2311                    writelistpublic($2); 
     2312                } 
     2313            } 
     2314     PublicDeclare = 0; 
     2315     PrivateDeclare = 0; 
     2316     } 
     2317     line-break 
     2318     ; 
     2319 
     2320opt-access-id-list: 
     2321     {$$=(listname *)NULL;} 
     2322     | opt-TOK_FOURDOTS access-id-list 
     2323     {$$=$2;} 
     2324     ; 
     2325 
     2326access-id-list: access-id 
     2327     {$$=Insertname(NULL,$1,0);} 
     2328     | access-id-list ',' access-id 
     2329     {$$=Insertname($1,$3,0);} 
     2330     ; 
     2331      
     2332/* R525 : access-id */ 
     2333access-id: TOK_NAME 
     2334     | generic-spec 
     2335     ; 
     2336      
     2337/* R534 : data-stmt */ 
     2338data-stmt: TOK_DATA data-stmt-set opt-data-stmt-set-nlist 
     2339        { 
     2340            /* we should remove the data declaration                */ 
     2341            pos_end = setposcur(); 
     2342            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata); 
     2343            if ( aftercontainsdeclare == 1  && firstpass == 0 ) 
     2344            { 
     2345                ReWriteDataStatement_0(fortran_out); 
     2346                pos_end = setposcur(); 
     2347            } 
     2348            Init_List_Data_Var(); 
     2349        } 
     2350        line-break 
     2351     ; 
     2352 
     2353opt-data-stmt-set-nlist: 
     2354     | data-stmt-set-nlist 
     2355     ; 
     2356 
     2357data-stmt-set-nlist: opt-comma data-stmt-set 
     2358     | data-stmt-set-nlist opt-comma data-stmt-set 
     2359     ; 
     2360 
     2361/* R535 : data-stmt-set */ 
     2362data-stmt-set: data-stmt-object-list TOK_SLASH data-stmt-value-list TOK_SLASH 
     2363        { 
     2364            if (firstpass == 1)   
     2365            { 
     2366            Add_Data_Var_Names_01(&List_Data_Var,$1,$3); 
     2367            } 
     2368            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3); 
     2369        } 
     2370     ; 
     2371 
     2372data-stmt-object-list: data-stmt-object 
     2373     { $$=insertvar(NULL,$1); } 
     2374     | data-stmt-object-list ',' data-stmt-object 
     2375     { 
     2376     $$ = insertvar($1,$3); 
     2377     } 
     2378     ; 
     2379 
     2380data-stmt-value-list: data-stmt-value 
     2381     {$$=Insertname(NULL,$1,0);} 
     2382     | data-stmt-value-list ',' data-stmt-value 
     2383     {$$ = Insertname($1,$3,1);   } 
     2384     ; 
     2385      
     2386/* R536 : data-stmt-object */ 
     2387data-stmt-object: variable 
     2388     | data-implied-do 
     2389     ; 
     2390  
     2391/* R537 : data-implied-do */             
     2392data-implied-do: '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ')' 
     2393     {printf("DOVARIABLE = %s %s %s\n",$4,$6,$8); 
     2394     printf("AUTRE = %s %s\n",$2->var->v_nomvar,$2->var->v_initialvalue_array); 
     2395     Insertdoloop($2->var,$4,$6,$8,""); 
     2396     $$=$2->var; 
     2397     } 
     2398     | '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ',' scalar-int-constant-expr ')' 
     2399     { 
     2400     Insertdoloop($2->var,$4,$6,$8,$10); 
     2401     $$=$2->var; 
     2402     } 
     2403     ; 
     2404 
     2405data-i-do-object-list: data-i-do-object 
     2406     {$$=insertvar(NULL,$1);} 
     2407     | data-i-do-object-list ',' data-i-do-object 
     2408     {$$ = insertvar($1,$3);} 
     2409     ; 
     2410 
     2411/* R538 : data-i-do-object */ 
     2412data-i-do-object: array-element 
     2413     | scalar-structure-component 
     2414     {$$->v_initialvalue_array=Insertname($$->v_initialvalue_array,my_dim.last,0); 
     2415     strcpy(my_dim.last,""); 
     2416     } 
     2417     | data-implied-do 
     2418     ; 
     2419 
     2420/* R539 : data-i-do-variable */ 
     2421data-i-do-variable: do-variable 
     2422     ; 
     2423 
     2424/* R540 : data-stmt-value */ 
     2425/* data-stmt-repeat and first data-stmt-constant inlined */ 
     2426data-stmt-value: scalar-constant-subobject opt-data-stmt-star 
     2427     {sprintf($$,"%s%s",$1,$2);} 
     2428     | int-literal-constant opt-data-stmt-star 
     2429     {sprintf($$,"%s%s",$1,$2);} 
     2430     | char-literal-constant opt-data-stmt-star 
     2431     {sprintf($$,"%s%s",$1,$2);} 
     2432     | signed-int-literal-constant 
     2433     | signed-real-literal-constant 
     2434     | null-init 
     2435     | initial-data-target 
     2436     | structure-constructor 
     2437     ; 
     2438 
     2439opt-data-stmt-star: 
     2440     {strcpy($$,"");} 
     2441     | '*' data-stmt-constant 
     2442     {sprintf($$,"*%s",$2);} 
     2443     ; 
     2444 
     2445opt-data-stmt-repeat-star: 
     2446     | data-stmt-repeat '*' 
     2447     ; 
     2448 
     2449/* R541 : data-stmt-repeat */ 
     2450/* scalar-int-constant inlined */ 
     2451 
     2452data-stmt-repeat: scalar-int-constant 
     2453     | scalar-int-constant-subobject 
     2454     ; 
     2455 
     2456/* R542 : data-stmt-constant */ 
     2457data-stmt-constant: scalar-constant 
     2458     | scalar-constant-subobject 
     2459     | signed-int-literal-constant 
     2460     | signed-real-literal-constant 
     2461     | null-init 
     2462     | initial-data-target 
     2463     | structure-constructor 
     2464     ; 
     2465 
     2466scalar-int-constant-subobject: int-constant-subobject 
     2467     ; 
     2468 
     2469scalar-constant-subobject: constant-subobject 
     2470     ; 
     2471 
     2472/* R543 : int-constant-subobject */ 
     2473int-constant-subobject: constant-subobject 
     2474     ; 
     2475      
     2476/* R544 : constant-subobject */ 
     2477constant-subobject: designator 
     2478     {strcpy(my_dim.last,"");} 
     2479     ; 
     2480      
     2481/* R545 : dimension-stmt */ 
     2482dimension-stmt: {positioninblock = 0; pos_curdimension = my_position_before;} 
     2483     TOK_DIMENSION opt-TOK_FOURDOTS array-name-spec-list 
     2484        { 
     2485            /* if the variable is a parameter we can suppose that is   */ 
     2486            /*    value is the same on each grid. It is not useless to */ 
     2487            /*    create a copy of it on each grid                     */ 
     2488            if ( ! inside_type_declare ) 
     2489            { 
     2490                if ( firstpass ) 
     2491                { 
     2492                    Add_Globliste_1($4); 
     2493                    /* if variableparamlists has been declared in a subroutine   */ 
     2494                    if ( insubroutinedeclare )     Add_Dimension_Var_1($4); 
     2495                     
     2496                    /* Add it to the List_SubroutineDeclaration_Var list if not present */ 
     2497                    /* NB: if not done, a variable declared with DIMENSION but with no type given */ 
     2498                    /* will not be declared by the conv */ 
     2499                    ReWriteDeclarationAndAddTosubroutine_01($4); 
     2500                } 
     2501                else 
    13472502                { 
    13482503                    pos_end = setposcur(); 
    1349                     RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse); 
     2504                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension); 
     2505                    ReWriteDeclarationAndAddTosubroutine_01($4); 
    13502506                } 
    13512507            } 
    1352         } 
    1353       | word_use TOK_NAME ',' rename_list 
    1354         { 
     2508            PublicDeclare = 0; 
     2509            PrivateDeclare = 0; 
     2510            ExternalDeclare = 0; 
     2511            strcpy(NamePrecision,""); 
     2512            c_star = 0; 
     2513            InitialValueGiven = 0 ; 
     2514            strcpy(IntentSpec,""); 
     2515            VariableIsParameter =  0 ; 
     2516            Allocatabledeclare = 0 ; 
     2517            Targetdeclare = 0 ; 
     2518            SaveDeclare = 0; 
     2519            pointerdeclare = 0; 
     2520            optionaldeclare = 0 ; 
     2521            dimsgiven=0; 
     2522            c_selectorgiven=0; 
     2523            strcpy(nameinttypename,""); 
     2524            strcpy(c_selectorname,""); 
     2525        } 
     2526     line-break 
     2527     ; 
     2528      
     2529array-name-spec-list: TOK_NAME '(' {in_complex_literal = 0;} array-spec ')' 
     2530     { 
     2531        if ( inside_type_declare ) break; 
     2532        curvar = createvar($1,$4); 
     2533        CreateAndFillin_Curvar("", curvar); 
     2534        curlistvar=insertvar(NULL, curvar); 
     2535        $$ = settype("",curlistvar); 
     2536        strcpy(vallengspec,""); 
     2537     } 
     2538     | array-name-spec-list ',' TOK_NAME '(' {in_complex_literal = 0;} array-spec ')' 
     2539        { 
     2540        if ( inside_type_declare ) break; 
     2541        curvar = createvar($3,$6); 
     2542        CreateAndFillin_Curvar("", curvar); 
     2543        curlistvar = insertvar($1, curvar); 
     2544        $$ = curlistvar; 
     2545        strcpy(vallengspec,""); 
     2546        } 
     2547     ; 
     2548 
     2549 
     2550/* R548 : parameter-stmt */ 
     2551parameter-stmt: TOK_PARAMETER { VariableIsParameter = 1; pos_curparameter = setposcur()-9; } '(' named-constant-def-list ')' 
     2552        { 
     2553            if ( ! inside_type_declare ) 
     2554            { 
     2555                if ( firstpass ) 
     2556                { 
     2557                    if ( insubroutinedeclare )  Add_Parameter_Var_1($4); 
     2558                    else                        Add_GlobalParameter_Var_1($4); 
     2559                } 
     2560                else 
     2561                { 
     2562                    pos_end = setposcur(); 
     2563                    RemoveWordSET_0(fortran_out, pos_curparameter, pos_end-pos_curparameter); 
     2564                } 
     2565            } 
     2566            VariableIsParameter =  0 ; 
     2567        } 
     2568        line-break 
     2569     ; 
     2570 
     2571named-constant-def-list: named-constant-def 
     2572     {$$=insertvar(NULL,$1);} 
     2573     | named-constant-def-list ',' named-constant-def 
     2574     {$$=insertvar($1,$3);} 
     2575     ; 
     2576 
     2577/* R549 : named-constant-def */ 
     2578named-constant-def: TOK_NAME '=' constant-expr 
     2579        { 
     2580            if ( inside_type_declare ) break; 
     2581            curvar=(variable *) calloc(1,sizeof(variable)); 
     2582            Init_Variable(curvar); 
     2583            curvar->v_VariableIsParameter = 1; 
     2584            strcpy(curvar->v_nomvar,$1); 
     2585            strcpy(curvar->v_subroutinename,subroutinename); 
     2586            strcpy(curvar->v_modulename,curmodulename); 
     2587            curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0); 
     2588            strcpy(curvar->v_commoninfile,cur_filename); 
     2589            Save_Length($3,14); 
     2590            $$ = curvar; 
     2591        } 
     2592     ; 
     2593 
     2594/* R553 : save-stmt */ 
     2595save-stmt: {pos_cursave = my_position_before;} TOK_SAVE opt-TOK_FOURDOTS opt-saved-entity-list 
     2596     { 
     2597     pos_end = setposcur(); 
     2598     RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave); 
     2599     } 
     2600     line-break 
     2601     ; 
     2602 
     2603opt-TOK_FOURDOTS: 
     2604     | TOK_FOURDOTS 
     2605     ; 
     2606 
     2607opt-saved-entity-list: 
     2608     | saved-entity-list 
     2609     ; 
     2610 
     2611saved-entity-list: saved-entity 
     2612     | saved-entity-list ',' saved-entity 
     2613     ; 
     2614 
     2615/* R554 : saved-entity */ 
     2616saved-entity: object-name 
     2617     {if ( ! inside_type_declare ) Add_Save_Var_1($1,(listdim*) NULL); } 
     2618     | proc-pointer-name 
     2619     | common-block-name 
     2620     ; 
     2621 
     2622/* R555 : proc-pointer-name */ 
     2623proc-pointer-name: ident 
     2624     ; 
     2625 
     2626get_my_position: 
     2627     {my_position = my_position_before;} 
     2628     ; 
     2629 
     2630/* R560 : implicit-stmt */ 
     2631implicit-stmt: get_my_position TOK_IMPLICIT implicit-spec-list line-break 
     2632    | get_my_position TOK_IMPLICIT TOK_NONE 
     2633        { 
     2634            if ( insubroutinedeclare == 1 ) 
     2635            { 
     2636                Add_ImplicitNoneSubroutine_1(); 
     2637                pos_end = setposcur(); 
     2638                RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); 
     2639            } 
     2640        } 
     2641    line-break 
     2642    ; 
     2643 
     2644implicit-spec-list: implicit-spec 
     2645     | implicit-spec-list ',' implicit-spec 
     2646     ; 
     2647 
     2648/*R561 implicit-spec */ 
     2649implicit-spec: declaration-type-spec '(' letter-spec-list ')' 
     2650    ; 
     2651 
     2652letter-spec-list:letter-spec 
     2653     | letter-spec-list ',' letter-spec 
     2654     ; 
     2655      
     2656/* R562 : letter-spec */ 
     2657letter-spec: TOK_NAME 
     2658     | TOK_NAME '-' TOK_NAME 
     2659     ; 
     2660 
     2661/* R563 : namelist-stmt */ 
     2662namelist-stmt: TOK_NAMELIST TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list opt-namelist-other line-break 
     2663     ; 
     2664 
     2665opt-namelist-other: 
     2666     | opt-namelist-other opt-comma TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list 
     2667 
     2668namelist-group-object-list:namelist-group-object 
     2669     | namelist-group-object-list ',' namelist-group-object 
     2670     ; 
     2671 
     2672/* R564 : namelist-group-object */ 
     2673namelist-group-object: variable-name 
     2674    ; 
     2675 
     2676/* R565 : equivalence-stmt */ 
     2677equivalence-stmt:  TOK_EQUIVALENCE equivalence-set-list line-break 
     2678     ; 
     2679 
     2680equivalence-set-list:equivalence-set 
     2681     | equivalence-set-list ',' equivalence-set 
     2682     ; 
     2683 
     2684/* R566 : equivalence-set */ 
     2685equivalence-set: '(' {in_complex_literal=0;} equivalence-object ',' equivalence-object-list ')' 
     2686     ; 
     2687 
     2688equivalence-object-list:equivalence-object 
     2689     | equivalence-object-list ',' equivalence-object 
     2690     ; 
     2691 
     2692/* R567 : equivalence-object */      
     2693equivalence-object: variable-name 
     2694     | array-element 
     2695     | substring 
     2696     ; 
     2697 
     2698 
     2699/* R568 : common-stmt */ 
     2700common-stmt: TOK_COMMON { positioninblock = 0; pos_curcommon = my_position_before; indeclaration=1;} opt-common-block-name common-block-object-list opt-common-block-list 
     2701     { 
     2702            indeclaration = 0; 
     2703            if ( inside_type_declare ) break; 
     2704            pos_end = setposcur(); 
     2705            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); 
     2706     } 
     2707     line-break 
     2708     ; 
     2709 
     2710opt-common-block-name: 
     2711     | common-block-name 
     2712     { 
     2713     if ( inside_type_declare ) break; 
     2714     sprintf(charusemodule,"%s",$1); 
     2715     Add_NameOfCommon_1($1,subroutinename); 
     2716     } 
     2717     ; 
     2718      
     2719common-block-name:TOK_DSLASH 
     2720        { 
     2721            strcpy($$,""); 
     2722            positioninblock=0; 
     2723            strcpy(commonblockname,""); 
     2724        } 
     2725     | TOK_SLASH TOK_NAME TOK_SLASH 
     2726        { 
     2727            strcpy($$,$2); 
     2728            positioninblock=0; 
     2729            strcpy(commonblockname,$2); 
     2730        } 
     2731      ; 
     2732 
     2733opt-comma: 
     2734     | ',' 
     2735     ; 
     2736 
     2737opt-common-block-list: 
     2738     | opt-common-block-list opt-comma common-block-name 
     2739     { 
     2740     if ( inside_type_declare ) break; 
     2741     sprintf(charusemodule,"%s",$3); 
     2742     Add_NameOfCommon_1($3,subroutinename); 
     2743     } 
     2744     common-block-object-list 
     2745     ; 
     2746 
     2747 
     2748common-block-object-list: common-block-object 
     2749     {if ( ! inside_type_declare ) Add_Common_var_1(); } 
     2750     | common-block-object-list ',' common-block-object 
     2751     {if ( ! inside_type_declare ) Add_Common_var_1(); } 
     2752     ; 
     2753   
     2754/* R569 : common-block-object */ 
     2755/* variable-name replaced by TOK_NAME */ 
     2756/* because the corresponding variable do not have to be added to the listofsubroutine_used */ 
     2757 
     2758common-block-object: TOK_NAME 
     2759        { 
     2760            positioninblock = positioninblock + 1 ; 
     2761            strcpy(commonvar,$1); 
     2762            commondim = (listdim*) NULL; 
     2763        } 
     2764     | TOK_NAME '(' {in_complex_literal=0;} array-spec ')' 
     2765        { 
     2766            positioninblock = positioninblock + 1 ; 
     2767            strcpy(commonvar,$1); 
     2768            commondim = $4; 
     2769        } 
     2770     ; 
     2771 
     2772/* R601 : designator */ 
     2773designator: array-element 
     2774     | array-section 
     2775     | structure-component 
     2776     | substring 
     2777     {$$=createvar($1,NULL);} 
     2778     ; 
     2779/* R602 : variable */ 
     2780/*variable: designator 
     2781       | expr 
     2782       ; 
     2783*/ 
     2784 
     2785scalar-variable: variable 
     2786     ; 
     2787      
     2788variable: designator 
     2789       {if (strcmp(my_dim.last,"")) 
     2790       { 
     2791       $$->v_initialvalue_array=Insertname(NULL,my_dim.last,0); 
     2792       } 
     2793       strcpy(my_dim.last,""); 
     2794       } 
     2795       ; 
     2796        
     2797scalar-variable-name: variable-name 
     2798     ; 
     2799 
     2800/* R603 : variable-name */ 
     2801variable-name: ident 
     2802      ; 
     2803 
     2804scalar-logical-variable: logical-variable 
     2805      ; 
     2806 
     2807/* R604 : logical-variable */ 
     2808logical-variable: variable 
     2809      ; 
     2810 
     2811/* R605 : char-variable */ 
     2812char-variable: variable 
     2813       ; 
     2814 
     2815scalar-default-char-variable: default-char-variable 
     2816     ; 
     2817      
     2818/* R606 : default-char-variable */ 
     2819default-char-variable: variable 
     2820     ; 
     2821 
     2822scalar-int-variable: int-variable 
     2823      ; 
     2824       
     2825int-variable: variable 
     2826     ; 
     2827 
     2828/* R608 : substring */ 
     2829substring: data-ref 
     2830     | data-ref '(' substring-range ')' 
     2831     {sprintf($$,"%s(%s)",$1,$3);} 
     2832     | char-literal-constant '(' substring-range ')' 
     2833     {sprintf($$,"%s(%s)",$1,$3);} 
     2834     ; 
     2835 
     2836/* R609 : parent-string */ 
     2837/* IS INLINED IN SUBSTRING (R608) */ 
     2838/* 
     2839parent-string: scalar-variable-name 
     2840     | array-element 
     2841     | scalar-structure-component 
     2842     | scalar-constant 
     2843     ; 
     2844*/ 
     2845 
     2846/* R610 : substring-range */ 
     2847substring-range: opt-scalar-int-expr ':' opt-scalar-int-expr 
     2848     {sprintf($$,"%s:%s",$1,$3);} 
     2849     ; 
     2850 
     2851/* R611: data-ref */ 
     2852data-ref: part-ref opt-part-ref 
     2853     {sprintf($$,"%s%s",$1->v_nomvar,$2);} 
     2854     ; 
     2855      
     2856opt-part-ref: 
     2857     {strcpy($$,"");} 
     2858     | opt-part-ref '%' part-ref 
     2859     {sprintf($$,"%s%%%s",$1,$3->v_nomvar);} 
     2860     ; 
     2861 
     2862/* R612 : part-ref */ 
     2863part-ref:ident 
     2864     {$$=createvar($1,NULL);} 
     2865     | ident '(' {in_complex_literal=0;} section-subscript-list ')' 
     2866     {sprintf(ligne,"%s(%s)",$1,$4);$$=createvar($1,NULL);strcpy(my_dim.last,$4);} 
     2867     ; 
     2868      
     2869/* $$=createvar($1,insertdim(NULL,my_dim)); 
     2870{strcpy(my_dim.first,"1");strcpy(my_dim.last,$4);$$=createvar($1,insertdim(NULL,my_dim));} 
     2871} */ 
     2872 
     2873/*part-name: ident 
     2874     ; 
     2875*/ 
     2876 
     2877scalar-structure-component: structure-component 
     2878     ; 
     2879 
     2880/* R613 : structure-component */ 
     2881structure-component: data-ref 
     2882     {strcpy(my_dim.last,"");} 
     2883     ; 
     2884 
     2885/* R617 : array-element */ 
     2886array-element: data-ref 
     2887      {strcpy(my_dim.last,"");} 
     2888      ; 
     2889 
     2890/* R618 : array-section */ 
     2891array-section: data-ref 
     2892     {strcpy(my_dim.last,"");} 
     2893     | data-ref '(' substring-range ')' 
     2894     {strcpy(my_dim.last,"");} 
     2895      ; 
     2896 
     2897/* section-subscript-list can be empty ... */ 
     2898/* in contradiction with the grammar ... */ 
     2899section-subscript-list: 
     2900      {strcpy($$,"");} 
     2901      |  section-subscript 
     2902      {strcpy($$,$1);} 
     2903      | section-subscript-list ',' section-subscript 
     2904      {sprintf($$,"%s,%s",$1,$3);} 
     2905      ; 
     2906 
     2907opt-subscript: 
     2908     {strcpy($$,"");} 
     2909     | subscript 
     2910     ; 
     2911 
     2912/* R619 : subscript */ 
     2913subscript: scalar-int-expr 
     2914     ; 
     2915 
     2916/* R620 : section-subscript */ 
     2917/*section-subscript: subscript 
     2918     | subscript-triplet 
     2919     | vector-subscript 
     2920     ; 
     2921*/ 
     2922 
     2923/* USE OpenFortranParser rules */ 
     2924 
     2925section-subscript: expr section_subscript_ambiguous 
     2926     {sprintf($$,"%s%s",$1,$2);} 
     2927     | ':' 
     2928     {strcpy($$,":");} 
     2929     | ':' expr  
     2930     {sprintf($$,":%s",$2);} 
     2931     | ':' ':' expr 
     2932     {sprintf($$,": :%s",$3);} 
     2933     | ':' expr ':' expr 
     2934     {sprintf($$,":%s :%s",$2,$4);} 
     2935     | TOK_FOURDOTS expr 
     2936     {sprintf($$,"::%s",$2);} 
     2937     | vector-subscript 
     2938     | ident '=' expr 
     2939     {sprintf($$,"%s=%s",$1,$3);} 
     2940     | ident '=' '*' label 
     2941     {sprintf($$,"%s=*%s",$1,$4);} 
     2942     | '*' label 
     2943     {sprintf($$,"*%s",$2);} 
     2944     ; 
     2945 
     2946section_subscript_ambiguous: ':' 
     2947     {strcpy($$,":");} 
     2948     | ':' expr 
     2949     {sprintf($$,":%s",$2);} 
     2950     | ':' ':' expr 
     2951     {sprintf($$,": :%s",$3);} 
     2952     | ':' expr ':' expr 
     2953     {sprintf($$,":%s :%s",$2,$4);} 
     2954     | TOK_FOURDOTS expr 
     2955     {sprintf($$,"::%s",$2);} 
     2956     | 
     2957     {strcpy($$,"");} 
     2958     ; 
     2959/* R621 : subscript-triplet */ 
     2960subscript-triplet: opt-subscript ':' opt-subscript  
     2961     {sprintf($$,"%s:%s",$1,$3);} 
     2962     | opt-subscript ':' opt-subscript ':' stride 
     2963     {sprintf($$,"%s:%s:%s",$1,$3,$5);} 
     2964     ; 
     2965 
     2966/* R622 : stride */ 
     2967stride: scalar-int-expr 
     2968     ; 
     2969      
     2970/* R623 : vector-subscript */ 
     2971vector-subscript: int-expr 
     2972     ; 
     2973 
     2974/* R626 : allocate-stmt */ 
     2975allocate-stmt: TOK_ALLOCATE '(' {in_complex_literal=0;} allocation-list opt-alloc-opt-list-comma ')' 
     2976     {inallocate = 0;} 
     2977     line-break 
     2978     ; 
     2979 
     2980opt-type-spec-fourdots: 
     2981     | type-spec TOK_FOURDOTS 
     2982     ; 
     2983 
     2984opt-alloc-opt-list-comma: 
     2985     | ',' alloc-opt-list 
     2986     ; 
     2987 
     2988alloc-opt-list: 
     2989        alloc-opt 
     2990      | alloc-opt-list ',' alloc-opt 
     2991      ; 
     2992       
     2993/* R627 : alloc-opt */ 
     2994alloc-opt: TOK_ERRMSG errmsg-variable 
     2995     | TOK_STAT '=' stat-variable 
     2996     ; 
     2997      
     2998/* R628 : stat-variable */ 
     2999stat-variable: scalar-int-variable 
     3000     ; 
     3001      
     3002/* R629 : errmsg-variable */ 
     3003errmsg-variable: scalar-default-char-variable 
     3004    ; 
     3005 
     3006allocation-list: 
     3007        allocation 
     3008      | allocation-list ',' allocation 
     3009      ; 
     3010  
     3011/* R631 allocation */ 
     3012allocation: allocate-object opt-allocate-shape-spec-list-par 
     3013     ; 
     3014 
     3015/* R632 allocate-object */      
     3016allocate-object: variable-name 
     3017     | structure-component 
     3018     ; 
     3019 
     3020opt-allocate-shape-spec-list-par: 
     3021     | '(' allocate-shape-spec-list ')' 
     3022     ; 
     3023 
     3024allocate-shape-spec-list: 
     3025        allocate-shape-spec 
     3026      | allocate-shape-spec-list ',' allocate-shape-spec 
     3027      ; 
     3028 
     3029/* R633 : allocate-shape-spec */ 
     3030allocate-shape-spec: opt-lower-bound-expr upper-bound-expr 
     3031     ; 
     3032 
     3033opt-lower-bound-expr: 
     3034     | lower-bound-expr ':' 
     3035     ; 
     3036 
     3037/* R634 : lower-bound-expr */ 
     3038lower-bound-expr: scalar-int-expr 
     3039     ; 
     3040 
     3041/* R634 : upper-bound-expr */ 
     3042upper-bound-expr: scalar-int-expr 
     3043     ; 
     3044      
     3045/* R640 : deallocate-stmt */ 
     3046deallocate-stmt: TOK_DEALLOCATE '(' {in_complex_literal=0;} allocate-object-list opt-dealloc-opt-list-comma ')' 
     3047     {inallocate = 0;} 
     3048     line-break 
     3049     ; 
     3050 
     3051allocate-object-list: 
     3052        allocate-object 
     3053      | allocate-object-list ',' allocate-object 
     3054      ; 
     3055       
     3056opt-dealloc-opt-list-comma: 
     3057     | ',' dealloc-opt-list 
     3058     ; 
     3059 
     3060dealloc-opt-list: 
     3061        dealloc-opt 
     3062      | dealloc-opt-list ',' dealloc-opt 
     3063      ; 
     3064       
     3065/* R641 : dealloc-opt */ 
     3066dealloc-opt: TOK_ERRMSG errmsg-variable 
     3067     | TOK_STAT '=' stat-variable 
     3068     ; 
     3069 
     3070/* R701 : primary */ 
     3071/* remove type-param-name */ 
     3072/* constant replaced by literal-constant to avoid conflict with designato */ 
     3073/* real-part is added because potential conflicts with complex-literal-constant */ 
     3074 
     3075primary:  
     3076      designator 
     3077      { 
     3078      strcpy($$,$1->v_nomvar); 
     3079      if (strcasecmp(my_dim.last,"")) 
     3080      { 
     3081      strcat($$,"("); 
     3082      strcat($$,my_dim.last); 
     3083      strcat($$,")"); 
     3084      } 
     3085      } 
     3086      | literal-constant 
     3087      | array-constructor 
     3088      | function-reference 
     3089      | '(' expr ')' 
     3090     { sprintf($$,"(%s)",$2);} 
     3091     ; 
     3092 
     3093/* R702 : level-1-expr */ 
     3094level-1-expr: primary 
     3095      {strcpy(my_dim.last,"");} 
     3096     ; 
     3097 
     3098/* R704 : mult-operand */ 
     3099mult-operand: level-1-expr 
     3100     | level-1-expr power-op mult-operand 
     3101     {sprintf($$,"%s**%s",$1,$3);} 
     3102     ; 
     3103/* R705 : add-operand */ 
     3104add-operand: mult-operand 
     3105     | add-operand mult-op mult-operand 
     3106     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3107     ; 
     3108      
     3109/* R706 : level-2-expr */ 
     3110/* add signed-int-literal-constant because potential reduce conflict with add-op add-operand */ 
     3111 
     3112level-2-expr: add-operand 
     3113     | add-op add-operand 
     3114     { sprintf($$,"%s%s",$1,$2); } 
     3115     | level-2-expr add-op add-operand 
     3116     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3117     | signed-int-literal-constant 
     3118     | level-2-expr signed-int-literal-constant 
     3119     { sprintf($$,"%s%s",$1,$2); } 
     3120     ; 
     3121      
     3122/* R707 : power-op */ 
     3123power-op : TOK_DASTER 
     3124     ; 
     3125      
     3126/* R708 : mult-op */ 
     3127mult-op : '*' 
     3128     {strcpy($$,"*");} 
     3129     | TOK_SLASH 
     3130     ; 
     3131      
     3132/* R709 : add-op */ 
     3133add-op : '+' 
     3134     {strcpy($$,"+");} 
     3135     | '-' 
     3136     {strcpy($$,"-");}      
     3137     ;      
     3138 
     3139/* R710 : level-3-expr */ 
     3140level-3-expr: level-2-expr 
     3141     | level-3-expr concat-op level-2-expr 
     3142     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3143     ; 
     3144 
     3145/* R711 : concat-op */ 
     3146concat-op : TOK_DSLASH 
     3147     ; 
     3148/* R712 : level-4-expr */ 
     3149level-4-expr: level-3-expr 
     3150     | level-3-expr rel-op level-3-expr 
     3151     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3152     ; 
     3153 
     3154/* R713 : rel-op */ 
     3155rel-op : TOK_EQ 
     3156     | TOK_NE 
     3157     | TOK_LT 
     3158     | TOK_LE 
     3159     | TOK_GT 
     3160     | TOK_GE 
     3161     | TOK_EQUALEQUAL 
     3162     | TOK_SLASHEQUAL 
     3163     | '<' 
     3164     {strcpy($$,"<");} 
     3165     | TOK_INFEQUAL 
     3166     | '>' 
     3167     {strcpy($$,">");} 
     3168     | TOK_SUPEQUAL 
     3169     ; 
     3170 
     3171/* R714 : and-operand */ 
     3172/* level-4-expr inlined as level-3-expr */ 
     3173and-operand: level-4-expr 
     3174     | not-op level-4-expr 
     3175     { sprintf($$,"%s%s",$1,$2); } 
     3176     ; 
     3177 
     3178 
     3179/* R715 : or-operand */ 
     3180or-operand: and-operand 
     3181     | or-operand and-op and-operand 
     3182     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3183     ; 
     3184 
     3185 
     3186/* R716 : equiv-operand */ 
     3187equiv-operand : or-operand 
     3188     | equiv-operand or-op or-operand 
     3189     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3190     ; 
     3191 
     3192/* R717 : level-5-expr */ 
     3193level-5-expr: equiv-operand 
     3194     | level-5-expr equiv-op equiv-operand 
     3195     { sprintf($$,"%s%s%s",$1,$2,$3); } 
     3196     ; 
     3197 
     3198/* R718 : not-op */ 
     3199not-op: TOK_NOT 
     3200     ; 
     3201      
     3202/* R719 : and-op */ 
     3203and-op: TOK_AND 
     3204     ; 
     3205      
     3206/* R720 : or-op */ 
     3207or-op: TOK_OR 
     3208     ; 
     3209 
     3210/* R721 : equiv-op */ 
     3211equiv-op: TOK_EQV 
     3212     | TOK_NEQV 
     3213     ; 
     3214      
     3215/* R722 : expr */ 
     3216expr: level-5-expr 
     3217     ; 
     3218 
     3219scalar-default-char-expr: default-char-expr 
     3220     ; 
     3221 
     3222/* R725 : default-char-expr */ 
     3223default-char-expr : expr 
     3224       ; 
     3225 
     3226/* R726 : int-expr */ 
     3227int-expr: expr 
     3228       ; 
     3229 
     3230opt-scalar-int-expr: 
     3231     {strcpy($$,"");} 
     3232     | scalar-int-expr 
     3233     ; 
     3234 
     3235scalar-int-expr: int-expr 
     3236       ; 
     3237 
     3238/* R728 : specification-expr */ 
     3239specification-expr: scalar-int-expr 
     3240     { 
     3241     strcpy($$,$1); 
     3242     } 
     3243     ; 
     3244 
     3245/* R729 : constant-expr */ 
     3246constant-expr: expr 
     3247     {strcpy($$,$1);} 
     3248     ; 
     3249 
     3250scalar-default-char-constant-expr: default-char-constant-expr 
     3251     ; 
     3252      
     3253/* R730: default-char-constant-expr */ 
     3254default-char-constant-expr: default-char-expr 
     3255     ; 
     3256 
     3257scalar-int-constant-expr: int-constant-expr 
     3258     ; 
     3259 
     3260/* R731 : int-constant-expr */ 
     3261int-constant-expr: int-expr 
     3262     ; 
     3263 
     3264/* R732 : assignment-stmt */ 
     3265/* cannot use opt-label due to conflicts ... */ 
     3266 
     3267assignment-stmt: variable '=' expr line-break 
     3268      | label variable '=' expr line-break 
     3269      ; 
     3270 
     3271/* R733 : pointer-assignment-stmt */ 
     3272 
     3273/* data-pointer-object and proc-pointer-object replaced by designator */ 
     3274/*pointer-assignment-stmt: data-pointer-object opt-bounds-spec-list-par TOK_POINT_TO data-target line-break 
     3275     | data-pointer-object '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break 
     3276     | proc-pointer-object TOK_POINT_TO proc-target line-break 
     3277     ; 
     3278*/ 
     3279 
     3280pointer-assignment-stmt: designator opt-bounds-spec-list-par TOK_POINT_TO data-target line-break 
     3281     | designator '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break 
     3282     | designator TOK_POINT_TO proc-target line-break 
     3283     ; 
     3284      
     3285/* R734 : data-pointer-object */ 
     3286data-pointer-object: variable-name 
     3287     | scalar-variable '%' TOK_NAME 
     3288     ; 
     3289 
     3290opt-bounds-spec-list-par: 
     3291     | '(' bounds-spec-list ')' 
     3292     ; 
     3293 
     3294bounds-spec-list: 
     3295        bounds-spec 
     3296      | bounds-spec-list ',' bounds-spec 
     3297      ; 
     3298 
     3299bounds-remapping-list: 
     3300        bounds-remapping 
     3301      | bounds-remapping-list ',' bounds-remapping 
     3302      ; 
     3303       
     3304/* R735 : bounds-spec */ 
     3305bounds-spec: lower-bound-expr ':' 
     3306     ; 
     3307 
     3308/* R736 : bounds-remapping */ 
     3309bounds-remapping: lower-bound-expr ':' upper-bound-expr 
     3310     ; 
     3311      
     3312/* R737 : data-target */ 
     3313data-target: variable 
     3314     ; 
     3315 
     3316procedure-component-name: TOK_NAME 
     3317     ; 
     3318 
     3319/* R738 : proc-pointer-object */ 
     3320proc-pointer-object: proc-pointer-name 
     3321     | proc-component-ref 
     3322     ; 
     3323 
     3324/* R739 : proc-component-ref */ 
     3325proc-component-ref : scalar-variable '%' procedure-component-name 
     3326     ; 
     3327      
     3328/* R740 : proc-target */ 
     3329proc-target: expr 
     3330     | procedure-component-name 
     3331     | proc-component-ref 
     3332     ; 
     3333 
     3334/* R741 : where-stmt */ 
     3335where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt 
     3336      ; 
     3337 
     3338/* R742 : where-construct */ 
     3339where-construct: where-construct-stmt opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt 
     3340      ; 
     3341 
     3342opt-where-body-construct: 
     3343      | opt-where-body-construct where-body-construct 
     3344      ; 
     3345 
     3346opt-masked-elsewhere-construct : 
     3347      | opt-masked-elsewhere-construct masked-elsewhere-stmt opt-where-body-construct 
     3348      ; 
     3349 
     3350opt-elsewhere-construct: 
     3351      | opt-elsewhere-construct elsewhere-stmt opt-where-body-construct 
     3352      ; 
     3353 
     3354/* R743 : where-construct-stmt */ 
     3355where-construct-stmt: TOK_WHERE '(' mask-expr ')' line-break 
     3356      ; 
     3357 
     3358/* R744 : where-body-construct */ 
     3359where-body-construct: where-assignment-stmt 
     3360      | where-stmt 
     3361      | where-construct 
     3362      ; 
     3363 
     3364/* R745 : where-assignment-stmt */ 
     3365where-assignment-stmt: assignment-stmt 
     3366      ; 
     3367 
     3368/* R746 : mask-expr */ 
     3369mask-expr: expr 
     3370      ; 
     3371 
     3372/* R747 : masked-elsewhere-stmt */ 
     3373masked-elsewhere-stmt: TOK_ELSEWHEREPAR mask-expr ')' line-break 
     3374      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME line-break 
     3375      ; 
     3376 
     3377/* R748: elsewhere-stmt */ 
     3378elsewhere-stmt: TOK_ELSEWHERE line-break 
     3379      | TOK_ELSEWHERE TOK_NAME line-break 
     3380      ; 
     3381 
     3382/* R749: end-where-stmt */ 
     3383end-where-stmt: 
     3384        TOK_ENDWHERE line-break 
     3385      | TOK_ENDWHERE TOK_NAME line-break 
     3386      ; 
     3387 
     3388/* R752 : forall-header */ 
     3389forall-header : 
     3390     ; 
     3391 
     3392/* R801 : block */ 
     3393block: opt-execution-part-construct 
     3394      ; 
     3395 
     3396opt-execution-part-construct: 
     3397      | opt-execution-part-construct execution-part-construct 
     3398      ; 
     3399 
     3400/* R813 : do-construct */ 
     3401do-construct: 
     3402        block-do-construct 
     3403      | nonblock-do-construct 
     3404      ; 
     3405 
     3406do-construct: 
     3407        block-do-construct 
     3408      ; 
     3409       
     3410/* R814 : block-do-construct */ 
     3411 
     3412block-do-construct: label-do-stmt do-block end-do 
     3413      | nonlabel-do-stmt do-block end-do 
     3414      ; 
     3415 
     3416/* R815 : do-stmt */ 
     3417/*do-stmt: 
     3418        label-do-stmt 
     3419      | nonlabel-do-stmt 
     3420      ; 
     3421*/ 
     3422 
     3423/* R816 : label-do-stmt */ 
     3424label-do-stmt: TOK_NAME ':' TOK_PLAINDO_LABEL line-break 
     3425      |              TOK_PLAINDO_LABEL line-break 
     3426      | TOK_NAME ':' TOK_PLAINDO_LABEL loop-control line-break 
     3427      |              TOK_PLAINDO_LABEL loop-control line-break 
     3428      ; 
     3429       
     3430label-do-stmt-djview: TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW line-break 
     3431      |              TOK_PLAINDO_LABEL_DJVIEW line-break 
     3432      | TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW loop-control line-break 
     3433      |              TOK_PLAINDO_LABEL_DJVIEW loop-control line-break 
     3434      ; 
     3435       
     3436/* R817 : nonlabel-do-stmt */ 
     3437nonlabel-do-stmt: TOK_NAME ':' TOK_PLAINDO line-break 
     3438      |              TOK_PLAINDO line-break 
     3439      | TOK_NAME ':' TOK_PLAINDO loop-control line-break 
     3440      |              TOK_PLAINDO loop-control line-break 
     3441      ; 
     3442 
     3443/* R818 : loop-control */ 
     3444loop-control: 
     3445        opt_comma do-variable '=' expr ',' expr 
     3446      | opt_comma do-variable '=' expr ',' expr ',' expr 
     3447      | opt_comma TOK_WHILE '(' expr ')' 
     3448      | opt_comma TOK_CONCURRENT forall-header 
     3449      ; 
     3450 
     3451/* R819 : do-variable */ 
     3452do-variable: ident 
     3453     ; 
     3454 
     3455/* R820 : do-block */ 
     3456do-block: block 
     3457     ; 
     3458 
     3459/* R821 : end-do */ 
     3460/*end-do: end-do-stmt 
     3461     | do-term-action-stmt 
     3462     ; 
     3463*/ 
     3464 
     3465end-do: end-do-stmt 
     3466     | label-djview continue-stmt 
     3467     ; 
     3468 
     3469/* R822 : end-do-stmt */ 
     3470end-do-stmt: opt-label-djview TOK_ENDDO line-break 
     3471      | opt-label-djview TOK_ENDDO TOK_NAME line-break 
     3472      ; 
     3473 
     3474/* R823 : nonblock-do-construct */ 
     3475/* only outer-shared-do-construct is used */ 
     3476 
     3477/* 
     3478nonblock-do-construct: outer-shared-do-construct 
     3479      ; 
     3480*/ 
     3481 
     3482nonblock-do-construct: action-term-do-construct 
     3483      | outer-shared-do-construct 
     3484      ; 
     3485 
     3486 
     3487/* R824 : action-term-do-construct */ 
     3488 
     3489action-term-do-construct: label-do-stmt do-block do-term-action-stmt 
     3490      ; 
     3491       
     3492/* R825 : do-body */ 
     3493 
     3494do-body : 
     3495      | execution-part-construct do-body 
     3496      ; 
     3497 
     3498/* R826 : do-term-action-stmt */ 
     3499do-term-action-stmt:  label-djview do-term-action-stmt-special 
     3500      ; 
     3501 
     3502/* do-term-action-stmt-special */ 
     3503do-term-action-stmt-special: 
     3504      allocate-stmt 
     3505      | assignment-stmt 
     3506      | call-stmt 
     3507      | close-stmt 
     3508      | deallocate-stmt 
     3509      | flush-stmt 
     3510      | goto-stmt 
     3511      | TOK_REWIND after_rewind 
     3512      | TOK_NULLIFY '(' pointer_name_list ')' 
     3513      | if-stmt 
     3514      | inquire-stmt 
     3515      | open-stmt 
     3516      | print-stmt 
     3517      | read-stmt 
     3518      | rewind-stmt 
     3519      | where-stmt 
     3520      | write-stmt 
     3521      ; 
     3522 
     3523 
     3524/* R827 : outer-shared-do-construct */ 
     3525/* do-body is same as do-block  
     3526we extend the definition of outer-shared-do-construct 
     3527a label-do-stmt statement must be followed by a label-do-stmt-djview statement 
     3528*/ 
     3529 
     3530outer-shared-do-construct : label-do-stmt do-block label-do-stmt-djview-do-block-list inner-shared-do-construct 
     3531       | label-do-stmt do-block inner-shared-do-construct 
     3532       ; 
     3533 
     3534label-do-stmt-djview-do-block-list: label-do-stmt-djview do-block 
     3535       | label-do-stmt-djview-do-block-list label-do-stmt-djview do-block 
     3536       ; 
     3537 
     3538/* R828 : shared-term-do-construct */ 
     3539 
     3540shared-term-do-construct: outer-shared-do-construct 
     3541      | inner-shared-do-construct 
     3542      ; 
     3543     
     3544/* R829 : inner-shared-do-construct */ 
     3545/* do-body is same as do-block */ 
     3546inner-shared-do-construct: label-do-stmt-djview do-block do-term-shared-stmt 
     3547      ; 
     3548       
     3549/* R830 : do-term-shared-stmt */ 
     3550 
     3551do-term-shared-stmt: label-djview action-stmt 
     3552      ; 
     3553 
     3554opt-do-construct-name: 
     3555     | TOK_NAME 
     3556     ; 
     3557 
     3558/* R831 : cycle-stmt */ 
     3559cycle-stmt: TOK_CYCLE opt-do-construct-name line-break 
     3560     ; 
     3561 
     3562/* R832 : if-construct */ 
     3563if-construct: if-then-stmt block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt 
     3564      ; 
     3565   
     3566opt-else-if-stmt-block:  
     3567      | else-if-stmt-block 
     3568      | opt-else-if-stmt-block else-if-stmt-block 
     3569      ; 
     3570 
     3571else-if-stmt-block: else-if-stmt block 
     3572      ; 
     3573 
     3574opt-else-stmt-block:  
     3575      | else-stmt-block 
     3576      | opt-else-stmt-block else-if-stmt-block 
     3577      ; 
     3578 
     3579else-stmt-block: else-stmt block 
     3580        ; 
     3581 
     3582/* R833 : if-then-stmt */ 
     3583if-then-stmt: TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break 
     3584      | label TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break 
     3585      | opt-label TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break 
     3586      ; 
     3587 
     3588/* R834 : else-if-stmt */ 
     3589else-if-stmt:TOK_ELSEIF '(' expr ')' TOK_THEN line-break 
     3590      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME line-break 
     3591      ; 
     3592 
     3593/* R835 : else-stmt */ 
     3594else-stmt:TOK_ELSE line-break 
     3595      | TOK_ELSE TOK_NAME line-break 
     3596      ; 
     3597 
     3598/* R836 : end-if-stmt */ 
     3599end-if-stmt:TOK_ENDIF line-break 
     3600      | TOK_ENDIF TOK_NAME line-break 
     3601      ; 
     3602 
     3603/* R837 : if-stmt */ 
     3604if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' action-stmt 
     3605        ; 
     3606 
     3607/* R838 : case-construct */ 
     3608case-construct: select-case-stmt opt_case-stmt-block end-select-stmt 
     3609        ; 
     3610 
     3611opt_case-stmt-block: 
     3612        | case-stmt-block 
     3613        | opt_case-stmt-block case-stmt-block 
     3614        ; 
     3615 
     3616case-stmt-block: case-stmt block 
     3617        ; 
     3618 
     3619/* R839 : select-case-stmt */ 
     3620select-case-stmt :TOK_NAME ':' TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break 
     3621        |              TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break 
     3622        ; 
     3623 
     3624/* R840 : case-stmt */ 
     3625case-stmt:TOK_CASE case-selector line-break 
     3626        | TOK_CASE case-selector TOK_NAME line-break 
     3627        ; 
     3628 
     3629/* R840 : end-select-stmt */ 
     3630end-select-stmt: TOK_ENDSELECT {in_select_case_stmt--;} line-break 
     3631        | TOK_ENDSELECT TOK_NAME {in_select_case_stmt--;} line-break 
     3632        ; 
     3633 
     3634/* R843 : case-selector */ 
     3635case-selector: 
     3636          '(' {in_complex_literal=0;} case-value-range-list ')' 
     3637        | TOK_DEFAULT 
     3638        ; 
     3639 
     3640case-value-range-list: 
     3641        case-value-range 
     3642      | case-value-range-list ',' case-value-range 
     3643      ; 
     3644 
     3645/* R844: case-value-range */ 
     3646case-value-range : 
     3647        case-value 
     3648      | case-value ':' 
     3649      | ':' case-value 
     3650      | case-value ':' case-value 
     3651      ; 
     3652 
     3653/* R845 : case-value */ 
     3654case-value: expr 
     3655        ; 
     3656 
     3657/* R850 : exit-stmt */ 
     3658exit-stmt: TOK_EXIT line-break 
     3659       | TOK_EXIT TOK_NAME line-break 
     3660       ; 
     3661 
     3662/* R851 : goto-stmt */ 
     3663goto-stmt: TOK_PLAINGOTO label line-break 
     3664     ; 
     3665 
     3666/* R853 arithmetic-if-stmt */ 
     3667arithmetic-if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' label ',' label ',' label line-break 
     3668     ; 
     3669 
     3670/* R854 : continue-stmt */ 
     3671continue-stmt: opt-label TOK_CONTINUE line-break 
     3672        ; 
     3673 
     3674/* R855 : stop-stmt */ 
     3675stop-stmt: TOK_STOP line-break 
     3676     | TOK_STOP stop-code line-break 
     3677     ; 
     3678 
     3679/* R857 : stop-code */ 
     3680stop-code: scalar-default-char-constant-expr 
     3681    | scalar-int-constant-expr 
     3682    ; 
     3683 
     3684/* R901 : io-unit */ 
     3685io-unit : file-unit-number 
     3686        | '*' 
     3687        | internal-file-variable 
     3688        ; 
     3689 
     3690/* R902 : file-unit-number */ 
     3691file-unit-number : scalar-int-expr 
     3692        ; 
     3693 
     3694/* R902 : internal-file-variable */ 
     3695internal-file-variable : char-variable 
     3696        ; 
     3697 
     3698/* R904 : open-stmt */ 
     3699open-stmt: TOK_OPEN '(' {close_or_connect = 1;} connect-spec-list ')' {close_or_connect = 0;} line-break 
     3700        ; 
     3701 
     3702connect-spec-list: connect-spec 
     3703         | connect-spec-list ',' connect-spec 
     3704         ; 
     3705 
     3706/* R905 : connect-spec */ 
     3707connect-spec: file-unit-number 
     3708      | TOK_UNIT file-unit-number 
     3709      | TOK_ACCESS scalar-default-char-expr 
     3710      | TOK_ACTION scalar-default-char-expr 
     3711      | TOK_ERR label 
     3712      | TOK_FILE file-name-expr 
     3713      | TOK_FORM scalar-default-char-expr 
     3714      | TOK_IOSTAT scalar-int-variable 
     3715      | TOK_POSITION scalar-default-char-expr 
     3716      | TOK_RECL scalar-int-expr 
     3717      | TOK_STATUS '=' scalar-default-char-expr 
     3718      ; 
     3719 
     3720/* R906 : file-name-expr */ 
     3721file-name-expr: scalar-default-char-expr 
     3722     ; 
     3723 
     3724/* R907 : iomsg-variable */ 
     3725iomsg-variable: scalar-default-char-variable 
     3726     ; 
     3727 
     3728/* R908 : close-stmt */ 
     3729close-stmt: opt-label TOK_CLOSE '(' {close_or_connect = 1;} close-spec-list ')' line-break 
     3730        {close_or_connect = 0;} 
     3731        ; 
     3732 
     3733close-spec-list: close-spec 
     3734         | close-spec-list ',' close-spec 
     3735         ; 
     3736 
     3737/* R909 : close-spec */ 
     3738close-spec: file-unit-number 
     3739       | TOK_UNIT file-unit-number 
     3740       | TOK_IOSTAT scalar-int-variable 
     3741       | TOK_ERR label 
     3742       | TOK_STATUS '=' scalar-default-char-expr 
     3743       ; 
     3744 
     3745/* R910 : read-stmt */ 
     3746read-stmt: opt-label TOK_READ_PAR io-control-spec-list ')' 
     3747         { 
     3748         in_io_control_spec = 0; 
     3749         } 
     3750         line-break 
     3751        | opt-label TOK_READ_PAR io-control-spec-list ')' input-item-list 
     3752         { 
     3753         in_io_control_spec = 0; 
     3754         } 
     3755         line-break 
     3756        | opt-label TOK_READ format line-break 
     3757        | opt-label TOK_READ format ',' input-item-list line-break 
     3758        ; 
     3759         
     3760/* R911 : write-stmt */ 
     3761write-stmt: opt-label TOK_WRITE_PAR io-control-spec-list ')' 
     3762         { 
     3763         in_io_control_spec = 0; 
     3764         } 
     3765         line-break 
     3766        | opt-label TOK_WRITE_PAR io-control-spec-list ')'  output-item-list 
     3767         { 
     3768         in_io_control_spec = 0; 
     3769         } 
     3770         line-break 
     3771        ; 
     3772 
     3773/* R912 : print-stmt */ 
     3774print-stmt: opt-label TOK_PRINT format line-break 
     3775        | opt-label TOK_PRINT format ',' output-item-list line-break 
     3776        ; 
     3777io-control-spec-list: io-control-spec 
     3778         | io-control-spec-list ',' io-control-spec 
     3779         ; 
     3780 
     3781namelist-group-name: TOK_NAME 
     3782         ; 
     3783 
     3784/* R913 : io-control-spec */ 
     3785io-control-spec: io-unit 
     3786         | TOK_UNIT io-unit 
     3787         | format 
     3788         | namelist-group-name 
     3789         | TOK_NML namelist-group-name 
     3790         | TOK_FMT format 
     3791         | TOK_END label 
     3792         | TOK_EOR label 
     3793         | TOK_ERR label 
     3794         | TOK_IOSTAT scalar-int-variable 
     3795         | TOK_REC '=' scalar-int-expr 
     3796        ; 
     3797 
     3798/* R915 : format */ 
     3799format: default-char-expr 
     3800        | label 
     3801        | '*' 
     3802        ; 
     3803input-item-list: 
     3804         input-item 
     3805         | input-item-list ',' input-item 
     3806         ; 
     3807/* R916 : input-item */ 
     3808input-item: variable 
     3809        | io-implied-do 
     3810        ; 
     3811 
     3812output-item-list: 
     3813         output-item 
     3814         | output-item-list ',' output-item 
     3815         ; 
     3816 
     3817/* R917 : output-item */ 
     3818output-item: expr 
     3819        | io-implied-do 
     3820        ; 
     3821 
     3822/* R918 : io-implied-do */ 
     3823io-implied-do : '(' io-implied-do-object-list ',' io-implied-do-control ')' 
     3824        ; 
     3825 
     3826io-implied-do-object-list: io-implied-do-object 
     3827         | io-implied-do-object-list ',' io-implied-do-object 
     3828         ; 
     3829 
     3830/* R919 : io-implied-do-object */ 
     3831/* input-item removed since possible conflicts (output-item can be variable) */ 
     3832/* io-implied-do-object : input-item 
     3833        | output-item 
     3834        ; 
     3835*/ 
     3836 
     3837io-implied-do-object : output-item 
     3838        ;         
     3839 
     3840/* R920 : io-implied-do-control */ 
     3841io-implied-do-control: do-variable '=' scalar-int-expr ',' scalar-int-expr 
     3842        | do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr 
     3843        ; 
     3844 
     3845/* R926 : rewind-stmt */ 
     3846rewind-stmt: TOK_REWIND file-unit-number line-break 
     3847     | TOK_REWIND '(' position-spec-list ')' line-break 
     3848     ; 
     3849 
     3850position-spec-list: 
     3851        position-spec 
     3852      | position-spec-list ',' position-spec 
     3853      ; 
     3854       
     3855/* R927 : position-spec */ 
     3856position-spec: file-unit-number 
     3857     | TOK_UNIT file-unit-number 
     3858     | TOK_IOMSG iomsg-variable 
     3859     | TOK_IOSTAT scalar-int-variable 
     3860     | TOK_ERR label 
     3861     ; 
     3862 
     3863/* R928 : flush-stmt */ 
     3864flush-stmt: TOK_FLUSH file-unit-number line-break 
     3865     | TOK_FLUSH '(' flush-spec-list ')' line-break 
     3866     ; 
     3867 
     3868flush-spec-list: 
     3869        flush-spec 
     3870      | flush-spec-list ',' flush-spec 
     3871      ; 
     3872       
     3873/* R929 : flush-spec */ 
     3874flush-spec: file-unit-number 
     3875     | TOK_UNIT file-unit-number 
     3876     | TOK_IOSTAT scalar-int-variable 
     3877     | TOK_IOMSG iomsg-variable 
     3878     | TOK_ERR label 
     3879     ; 
     3880 
     3881 
     3882/* R930 : inquire-stmt */ 
     3883inquire-stmt: TOK_INQUIRE set_in_inquire '(' inquire-spec-list ')' 
     3884     {in_inquire=0;} 
     3885     line-break 
     3886     | TOK_INQUIRE set_in_inquire '(' TOK_IOLENGTH scalar-int-variable ')' output-item-list 
     3887     {in_inquire=0;} 
     3888     line-break 
     3889     ; 
     3890 
     3891set_in_inquire: {in_inquire=1;}   
     3892     ; 
     3893 
     3894inquire-spec-list: 
     3895        inquire-spec 
     3896      | inquire-spec-list ',' inquire-spec 
     3897      ; 
     3898       
     3899/* R931 : inquire-spec */ 
     3900inquire-spec: file-unit-number 
     3901     | TOK_UNIT file-unit-number 
     3902     | TOK_FILE file-name-expr 
     3903     | TOK_ACCESS scalar-default-char-variable 
     3904     | TOK_ACTION scalar-default-char-variable 
     3905     | TOK_ERR label 
     3906     | TOK_EXIST scalar-logical-variable 
     3907     | TOK_IOSTAT scalar-int-variable 
     3908     | TOK_NAME_EQ '=' scalar-default-char-variable 
     3909     | TOK_OPENED scalar-logical-variable 
     3910     | TOK_RECL scalar-int-variable 
     3911     ; 
     3912 
     3913/* R1001 : format-stmt */ 
     3914format-stmt: TOK_LABEL_FORMAT line-break 
     3915        ; 
     3916 
     3917/* R1104 : module */ 
     3918module:module-stmt opt-specification-part opt-module-subprogram-part {pos_endsubroutine=setposcur();} end-module-stmt 
     3919     ; 
     3920 
     3921opt-module-subprogram-part: 
     3922     | module-subprogram-part 
     3923     ; 
     3924 
     3925/* R1105 : module-stmt */ 
     3926module-stmt : TOK_MODULE TOK_NAME 
     3927        { 
     3928            GlobalDeclaration = 0; 
     3929            strcpy(curmodulename,$2); 
     3930            strcpy(subroutinename,""); 
     3931            Add_NameOfModule_1($2); 
     3932            if ( inmoduledeclare == 0 ) 
     3933            { 
     3934                /* To know if there are in the module declaration    */ 
     3935                inmoduledeclare = 1; 
     3936                /* to know if a module has been met                  */ 
     3937                inmodulemeet = 1; 
     3938                /* to know if we are after the keyword contains      */ 
     3939                aftercontainsdeclare = 0 ; 
     3940            } 
     3941        } 
     3942        line-break 
     3943     ; 
     3944 
     3945/* R1106 : end-module-stmt */ 
     3946end-module-stmt: get_my_position TOK_ENDUNIT opt-tok-module opt-ident 
     3947        { 
     3948            /* if we never meet the contains keyword               */ 
     3949            if ( firstpass == 0 ) 
     3950            { 
     3951                RemoveWordCUR_0(fortran_out, setposcur()-my_position);    // Remove word "end module" 
     3952                if ( inmoduledeclare && ! aftercontainsdeclare ) 
     3953                { 
     3954                    Write_Closing_Module(1); 
     3955                } 
     3956                fprintf(fortran_out,"\n      end module %s\n", curmodulename); 
     3957                if ( module_declar && insubroutinedeclare == 0 ) 
     3958                { 
     3959                    fclose(module_declar); 
     3960                } 
     3961            } 
     3962            inmoduledeclare = 0 ; 
     3963            inmodulemeet = 0 ; 
     3964            aftercontainsdeclare = 1; 
     3965            strcpy(curmodulename, ""); 
     3966            GlobalDeclaration = 0 ; 
     3967        } 
     3968        line-break 
     3969     ; 
     3970 
     3971opt-tok-module: 
     3972     | TOK_MODULE 
     3973     ; 
     3974 
     3975opt-ident: 
     3976     | TOK_NAME 
     3977     ; 
     3978/* R1107 : module-subprogram-part */ 
     3979module-subprogram-part:contains-stmt opt-module-subprogram-list 
     3980     ; 
     3981      
     3982opt-module-subprogram-list: 
     3983     | module-subprogram-list 
     3984     ; 
     3985      
     3986module-subprogram-list: module-subprogram 
     3987     | module-subprogram-list module-subprogram 
     3988     ; 
     3989 
     3990module-subprogram: function-subprogram 
     3991     | subroutine-subprogram 
     3992     ; 
     3993 
     3994use-stmt-list:use-stmt 
     3995     | use-stmt-list use-stmt 
     3996     ; 
     3997 
     3998save_olduse: 
     3999     {if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);} 
     4000     ; 
     4001      
     4002/* R1109 use-stmt */ 
     4003use-stmt: get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME opt-rename-list 
     4004    { 
    13554005            if ( firstpass ) 
    13564006            { 
    13574007                if ( insubroutinedeclare ) 
    13584008                { 
    1359                     Add_CouplePointed_Var_1($2,$4); 
    1360                     coupletmp = $4; 
    1361                     strcpy(ligne,""); 
    1362                     while ( coupletmp ) 
    1363                     { 
     4009                    if ($6) { 
     4010                      Add_CouplePointed_Var_1($5,$6); 
     4011                      coupletmp = $6; 
     4012                      strcpy(ligne,""); 
     4013                      while ( coupletmp ) 
     4014                      { 
    13644015                        strcat(ligne, coupletmp->c_namevar); 
    13654016                        strcat(ligne, " => "); 
     
    13674018                        coupletmp = coupletmp->suiv; 
    13684019                        if ( coupletmp ) strcat(ligne,","); 
     4020                      } 
     4021                      } 
     4022                  sprintf(charusemodule,"%s",$5); 
     4023                } 
     4024                Add_NameOfModuleUsed_1($5); 
     4025            } 
     4026            else 
     4027            { 
     4028                if ( insubroutinedeclare ) 
     4029                { 
     4030                  copyuse_0($5); 
    13694031                    } 
    1370                     sprintf(charusemodule,"%s",$2); 
    1371                 } 
    1372                 Add_NameOfModuleUsed_1($2); 
    1373             } 
    1374             if ( inmoduledeclare == 0 ) 
    1375             { 
    1376                 pos_end = setposcur(); 
    1377                 RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse); 
    1378             } 
    1379         } 
    1380       | word_use TOK_NAME ',' TOK_ONLY ':' '\n' 
    1381         { 
    1382             /* if variables has been declared in a subroutine       */ 
    1383             sprintf(charusemodule,"%s",$2); 
    1384             if ( firstpass ) 
    1385             { 
    1386                 Add_NameOfModuleUsed_1($2); 
    1387             } 
    1388             else 
    1389             { 
    1390                 if ( insubroutinedeclare ) 
    1391                     copyuseonly_0($2); 
    13924032 
    13934033                if ( inmoduledeclare == 0 ) 
    13944034                { 
    13954035                    pos_end = setposcur(); 
    1396                     RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse); 
     4036                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); 
    13974037                } 
    13984038            } 
    1399         } 
    1400       | word_use  TOK_NAME ',' TOK_ONLY ':' only_list 
    1401         { 
    1402             /* if variables has been declared in a subroutine      */ 
     4039    } 
     4040    line-break 
     4041    | get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME ',' TOK_ONLY ':' opt-only-list 
     4042    { 
    14034043            if ( firstpass ) 
    14044044            { 
    14054045                if ( insubroutinedeclare ) 
    14064046                { 
    1407                     Add_CouplePointed_Var_1($2,$6); 
    1408                     coupletmp = $6; 
     4047                  if ($9) 
     4048                  { 
     4049                    Add_CouplePointed_Var_1($5,$9); 
     4050                    coupletmp = $9; 
    14094051                    strcpy(ligne,""); 
    14104052                    while ( coupletmp ) 
     
    14164058                        if ( coupletmp ) strcat(ligne,","); 
    14174059                    } 
    1418                     sprintf(charusemodule,"%s",$2); 
     4060                  } 
     4061                  sprintf(charusemodule,"%s",$5); 
    14194062                } 
    1420                 Add_NameOfModuleUsed_1($2); 
    1421             } 
    1422             else /* if ( firstpass == 0 ) */ 
    1423             { 
     4063                Add_NameOfModuleUsed_1($5); 
     4064            } 
     4065            else 
     4066            { 
     4067                if ( insubroutinedeclare ) 
     4068                    copyuseonly_0($5); 
     4069 
    14244070                if ( inmoduledeclare == 0 ) 
    14254071                { 
    14264072                    pos_end = setposcur(); 
    1427                     RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse); 
    1428                     if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold); 
     4073                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); 
     4074                    if ($9) 
     4075                    { 
     4076                    if (oldfortran_out)  variableisglobalinmodule($9,$5,oldfortran_out,pos_curuseold); 
     4077                    } 
    14294078                } 
    14304079                else 
    14314080                { 
     4081                  if ($9) 
     4082                  { 
    14324083                    /* if we are in the module declare and if the    */ 
    14334084                    /* onlylist is a list of global variable         */ 
    1434                     variableisglobalinmodule($6, $2, fortran_out,pos_curuse); 
     4085                    variableisglobalinmodule($9, $5, fortran_out,my_position); 
     4086                  } 
    14354087                } 
    14364088            } 
    1437         } 
    1438       ; 
    1439 word_use : 
    1440         TOK_USE 
    1441         { 
    1442             pos_curuse = setposcur()-strlen($1); 
    1443             if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out); 
    1444         } 
    1445       ; 
    1446 rename_list : 
    1447         rename_name 
    1448         { 
    1449             $$ = $1; 
    1450         } 
    1451       | rename_list ',' rename_name 
    1452         { 
    1453             /* insert the variable in the list $1                 */ 
    1454             $3->suiv = $1; 
    1455             $$ = $3; 
    1456         } 
    1457       ; 
    1458 rename_name : TOK_NAME TOK_POINT_TO TOK_NAME 
     4089    } 
     4090    line-break 
     4091    ; 
     4092 
     4093opt-module-nature-2points: 
     4094    | TOK_FOURDOTS 
     4095    | ',' module-nature TOK_FOURDOTS 
     4096    ; 
     4097 
     4098opt-only-list: 
     4099    {$$=NULL;} 
     4100    | only-list 
     4101    {$$=$1;} 
     4102    ; 
     4103 
     4104/* R1101 : main-program */ 
     4105main-program: program-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-program-stmt 
     4106     ; 
     4107 
     4108opt-specification-part: 
     4109     | specification-part 
     4110     ; 
     4111 
     4112opt-execution-part: 
     4113     | execution-part 
     4114     ; 
     4115 
     4116/* R1102 : program-stmt */ 
     4117program-stmt: TOK_PROGRAM TOK_NAME  
     4118        { 
     4119            strcpy(subroutinename,$2); 
     4120            insubroutinedeclare = 1; 
     4121            inprogramdeclare = 1; 
     4122            /* in the second step we should write the head of       */ 
     4123            /*    the subroutine sub_loop_<subroutinename>          */ 
     4124            if ( ! firstpass ) 
     4125                WriteBeginof_SubLoop(); 
     4126        } 
     4127        line-break 
     4128     ; 
     4129 
     4130/* R1103 : end-program-stmt */ 
     4131end-program-stmt: {pos_endsubroutine=my_position_before;} TOK_ENDUNIT opt-tok-program opt-tok-name 
     4132     { 
     4133            insubroutinedeclare = 0; 
     4134            inprogramdeclare = 0; 
     4135            pos_cur = setposcur(); 
     4136            closeandcallsubloopandincludeit_0(3); 
     4137            functiondeclarationisdone = 0; 
     4138            strcpy(subroutinename,"");      
     4139     }      
     4140     line-break 
     4141     ; 
     4142 
     4143opt-tok-program: 
     4144     | TOK_PROGRAM 
     4145     ; 
     4146opt-tok-name: 
     4147     | TOK_NAME 
     4148     ; 
     4149/* R1110 : module-nature */ 
     4150module-nature: TOK_INTRINSIC 
     4151    ; 
     4152 
     4153opt-rename-list: 
     4154    { 
     4155    $$=NULL; 
     4156    } 
     4157    | ',' rename-list 
     4158    { 
     4159    $$=$2; 
     4160    } 
     4161    ; 
     4162     
     4163rename-list: rename 
     4164     { 
     4165     $$=$1; 
     4166     } 
     4167     | rename-list ',' rename 
     4168     { 
     4169     /* insert the variable in the list $1                 */ 
     4170     $3->suiv = $1; 
     4171     $$=$3; 
     4172     } 
     4173     ; 
     4174 
     4175/* R1111: rename */ 
     4176rename: TOK_NAME TOK_POINT_TO TOK_NAME 
    14594177        { 
    14604178            coupletmp = (listcouple *) calloc(1,sizeof(listcouple)); 
     
    14644182            $$ = coupletmp; 
    14654183        } 
    1466       ; 
    1467 only_list : 
    1468         only_name   {  $$ = $1; } 
    1469       | only_list ',' only_name 
     4184     ; 
     4185 
     4186only-list:only 
     4187     {$$=$1;} 
     4188     | only-list ',' only 
    14704189        { 
    14714190            /* insert the variable in the list $1                 */ 
     
    14734192            $$ = $3; 
    14744193        } 
    1475       ; 
    1476 only_name : 
    1477         TOK_NAME TOK_POINT_TO TOK_NAME 
    1478         { 
    1479             coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); 
    1480             strcpy(coupletmp->c_namevar,$1); 
    1481             strcpy(coupletmp->c_namepointedvar,$3); 
    1482             coupletmp->suiv = NULL; 
    1483             $$ = coupletmp; 
    1484             pointedvar = 1; 
    1485             Add_UsedInSubroutine_Var_1($1); 
    1486         } 
    1487       | TOK_NAME 
     4194     ; 
     4195 
     4196/* R1112: only */ 
     4197only:generic-spec 
    14884198        { 
    14894199            coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); 
     
    14934203            $$ = coupletmp; 
    14944204        } 
    1495       ; 
    1496  
    1497 /* R209 : execution-part-construct */ 
    1498 execution-part-construct: 
    1499         executable-construct 
    1500       | format-stmt 
    1501       ; 
    1502  
    1503 /* R213 : executable-construct */ 
    1504 executable-construct: 
    1505         action-stmt 
    1506       | do-construct 
    1507       | case-construct 
    1508       | if-construct 
    1509       | where-construct 
    1510       ; 
    1511  
    1512 /* R214 : action-stmt */ 
    1513 action-stmt : 
    1514         TOK_CONTINUE 
    1515       | ident_dims after_ident_dims 
    1516       | goto 
    1517       | call 
    1518       | iofctl ioctl 
    1519       | read option_read 
    1520       | TOK_WRITE ioctl 
    1521       | TOK_WRITE ioctl outlist 
    1522       | TOK_REWIND after_rewind 
    1523       | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; } 
    1524       | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; } 
    1525       | TOK_EXIT optexpr 
    1526       | TOK_RETURN opt_expr 
    1527       | TOK_CYCLE opt_expr 
    1528       | stop opt_expr 
    1529       | int_list 
    1530       | TOK_NULLIFY '(' pointer_name_list ')' 
    1531       | word_endunit 
    1532         { 
     4205     | only-use-name 
     4206        { 
     4207            coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); 
     4208            strcpy(coupletmp->c_namevar,$1); 
     4209            strcpy(coupletmp->c_namepointedvar,""); 
     4210            coupletmp->suiv = NULL; 
     4211            $$ = coupletmp; 
     4212        } 
     4213     | rename 
     4214     { 
     4215     $$=$1; 
     4216     pointedvar = 1; 
     4217      Add_UsedInSubroutine_Var_1($1->c_namevar); 
     4218     } 
     4219     ; 
     4220/* R1113 : only-use-name */ 
     4221only-use-name: TOK_NAME 
     4222     ; 
     4223 
     4224/* R1207: generic-spec */ 
     4225generic-spec: TOK_NAME 
     4226     ; 
     4227 
     4228/* R1210 : external-stmt */ 
     4229external-stmt: TOK_EXTERNAL external-name-list line-break 
     4230     | TOK_EXTERNAL TOK_FOURDOTS external-name-list line-break 
     4231     ; 
     4232      
     4233external-name-list: external-name 
     4234     | external-name-list ',' external-name 
     4235     ; 
     4236      
     4237external-name: TOK_NAME 
     4238     ; 
     4239 
     4240/* R1218 : intrinsic-stmt */ 
     4241intrinsic-stmt: TOK_INTRINSIC opt-TOK_FOURDOTS intrinsic-procedure-name-list line-break 
     4242     ; 
     4243 
     4244intrinsic-procedure-name-list: 
     4245        intrinsic-procedure-name 
     4246      | intrinsic-procedure-name-list ',' intrinsic-procedure-name 
     4247      ; 
     4248       
     4249intrinsic-procedure-name: TOK_NAME 
     4250     ; 
     4251 
     4252/* R1219 : function-reference */ 
     4253function-reference: procedure-designator '(' ')' 
     4254     | procedure-designator '(' {in_complex_literal=0;} actual-arg-spec-list ')' 
     4255     {sprintf($$,"%s(%s)",$[procedure-designator],$[actual-arg-spec-list]);} 
     4256     ; 
     4257 
     4258/* R1220 :  
     4259*/ 
     4260call-stmt: before-call-stmt 
     4261             { 
     4262            inagrifcallargument = 0 ; 
     4263            incalldeclare=0; 
     4264            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) 
     4265            { 
     4266                pos_end = setposcur(); 
     4267                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); 
     4268                strcpy(subofagrifinitgrids,subroutinename); 
     4269            } 
     4270            Instanciation_0(sameagrifname); 
     4271        } 
     4272        line-break 
     4273     | before-call-stmt '(' ')' 
     4274             { 
     4275            inagrifcallargument = 0 ; 
     4276            incalldeclare=0; 
     4277            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) 
     4278            { 
     4279                pos_end = setposcur(); 
     4280                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); 
     4281                strcpy(subofagrifinitgrids,subroutinename); 
     4282            } 
     4283            Instanciation_0(sameagrifname); 
     4284        } 
     4285        line-break 
     4286     | before-call-stmt '(' {in_complex_literal=0;} actual-arg-spec-list ')' 
     4287        { 
     4288            inagrifcallargument = 0 ; 
     4289            incalldeclare=0; 
     4290            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) 
     4291            { 
     4292                pos_end = setposcur(); 
     4293                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); 
     4294                strcpy(subofagrifinitgrids,subroutinename); 
     4295            } 
     4296            Instanciation_0(sameagrifname); 
     4297        } 
     4298        line-break 
     4299     ; 
     4300 
     4301before-call-stmt: opt-label TOK_CALL {pos_curcall=my_position_before-strlen($[opt-label])-4;} procedure-designator 
     4302             { 
     4303            if (!strcasecmp($[procedure-designator],"MPI_Init") )    callmpiinit = 1; 
     4304            else                                callmpiinit = 0; 
     4305 
     4306            if (!strcasecmp($[procedure-designator],"Agrif_Init_Grids") ) 
     4307            { 
     4308                callagrifinitgrids = 1; 
     4309                strcpy(meetagrifinitgrids,subroutinename); 
     4310            } 
     4311            else 
     4312            { 
     4313                callagrifinitgrids = 0; 
     4314            } 
     4315            if ( Vartonumber($[procedure-designator]) == 1 ) 
     4316            { 
     4317                incalldeclare = 0; 
     4318                inagrifcallargument = 0 ; 
     4319                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); 
     4320            } 
     4321        } 
     4322        ; 
     4323 
     4324/* R1221 : procedure-designator */ 
     4325procedure-designator: ident 
     4326     | TOK_FLUSH 
     4327     | TOK_REAL 
     4328     ; 
     4329 
     4330actual-arg-spec-list: 
     4331        actual-arg-spec 
     4332      | actual-arg-spec-list ',' actual-arg-spec 
     4333      {sprintf($$,"%s,%s",$1,$[actual-arg-spec]);} 
     4334      ; 
     4335 
     4336/* R1222 : actual-arg-spec */ 
     4337actual-arg-spec: actual-arg 
     4338        { 
     4339            if ( callmpiinit == 1 ) 
     4340            { 
     4341                strcpy(mpiinitvar,$1); 
     4342                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar); 
     4343            } 
     4344        }      
     4345     | keyword '=' actual-arg 
     4346     {sprintf($$,"%s = %s",$1,$3); 
     4347                 if ( callmpiinit == 1 ) 
     4348            { 
     4349                strcpy(mpiinitvar,$3); 
     4350                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar); 
     4351            } 
     4352            } 
     4353     ; 
     4354 
     4355/* R1223 : actual-arg */ 
     4356actual-arg: expr 
     4357     | variable 
     4358     { 
     4359     strcpy($$,$1->v_nomvar); 
     4360     if ($1->v_initialvalue_array) 
     4361     { 
     4362     strcat($$,"("); 
     4363     strcat($$,$1->v_initialvalue_array->n_name); 
     4364     strcat($$,")"); 
     4365     } 
     4366     } 
     4367     | ident 
     4368     ; 
     4369 
     4370opt-prefix:     {isrecursive = 0;} 
     4371     | prefix 
     4372     ; 
     4373      
     4374/* R1225 : prefix */ 
     4375prefix: prefix-spec 
     4376     | prefix prefix-spec 
     4377     ; 
     4378 
     4379/* R1226 prefix-spec */ 
     4380prefix-spec: declaration-type-spec 
     4381     {isrecursive = 0; functiondeclarationisdone = 1;} 
     4382     | TOK_MODULE 
     4383     {isrecursive = 0;} 
     4384     | TOK_RECURSIVE 
     4385     {isrecursive = 1;} 
     4386     ; 
     4387 
     4388/*R1227 : function-subprogram */ 
     4389function-subprogram: function-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-function-stmt 
     4390     ; 
     4391 
     4392/* R1228 : function-stmt */ 
     4393function-stmt: opt-prefix TOK_FUNCTION 
     4394     function-name '(' {in_complex_literal=0;} opt-dummy-arg-list ')' opt-suffix 
     4395     { 
     4396            insubroutinedeclare = 1; 
     4397            suborfun = 0; 
     4398            /* we should to list of the subroutine argument the  */ 
     4399            /*    name of the function which has to be defined   */ 
     4400            if ( firstpass ) 
     4401            { 
     4402                Add_SubroutineArgument_Var_1($[opt-dummy-arg-list]); 
     4403                if ( ! is_result_present ) 
     4404                    Add_FunctionType_Var_1($[function-name]); 
     4405            } 
     4406            else 
     4407            /* in the second step we should write the head of    */ 
     4408            /*    the subroutine sub_loop_<subroutinename>       */ 
     4409               { 
     4410                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Avant Writebeginof subloop\n"); 
     4411                WriteBeginof_SubLoop(); 
     4412                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Apres Writebeginof subloop\n"); 
     4413                } 
     4414                strcpy(NamePrecision,""); 
     4415     } 
     4416     line-break 
     4417     ; 
     4418 
     4419function-name: TOK_NAME 
     4420     { 
     4421     if (strcmp(subroutinename,"")) 
     4422     { 
     4423     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram 
     4424     old_oldfortran_out=oldfortran_out; 
     4425     } 
     4426     else 
     4427     { 
     4428     old_oldfortran_out=(FILE *)NULL; 
     4429     } 
     4430     strcpy($$,$1);strcpy(subroutinename,$1); 
     4431     } 
     4432     ; 
     4433 
     4434opt-dummy-arg-name-list: 
     4435     | dummy-arg-name-list 
     4436     ; 
     4437 
     4438dummy-arg-name-list: 
     4439        dummy-arg-name 
     4440      | dummy-arg-name-list ',' dummy-arg-name 
     4441      ; 
     4442 
     4443/* R1230 : dummy-arg-name */ 
     4444dummy-arg-name: TOK_NAME 
     4445     {strcpy($$,$1);} 
     4446     ; 
     4447 
     4448opt-suffix: 
     4449     {is_result_present = 0; } 
     4450     | suffix 
     4451     ; 
     4452      
     4453/* R1231 : suffix */ 
     4454suffix: TOK_RESULT '(' TOK_NAME ')' 
     4455     {is_result_present = 1; 
     4456                 if ( firstpass == 1 ) 
     4457            { 
     4458                strcpy(nameinttypenameback,nameinttypename); 
     4459                strcpy(nameinttypename,""); 
     4460                curvar = createvar($3,NULL); 
     4461                strcpy(nameinttypename,nameinttypenameback); 
     4462                strcpy(curvar->v_typevar,""); 
     4463                curlistvar = insertvar(NULL,curvar); 
     4464                Add_SubroutineArgument_Var_1(curlistvar); 
     4465            } 
     4466     } 
     4467     ; 
     4468 
     4469/* R1232 : end-function-stmt */ 
     4470end-function-stmt: get_my_position TOK_ENDUNIT opt-tok-function opt-ident close_subroutine 
     4471     {strcpy(DeclType, "");} 
     4472     line-break 
     4473     ; 
     4474 
     4475opt-tok-function: 
     4476     | TOK_FUNCTION 
     4477     ; 
     4478 
     4479/*R1233 : subroutine-subprogram */ 
     4480subroutine-subprogram: subroutine-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-subroutine-stmt 
     4481     ; 
     4482      
     4483/* R1234 : subroutine-stmt */ 
     4484subroutine-stmt: opt-prefix TOK_SUBROUTINE subroutine-name opt-dummy-arg-list-par 
     4485        { 
     4486            insubroutinedeclare = 1; 
     4487            suborfun = 1; 
     4488            if ( firstpass ) 
     4489                Add_SubroutineArgument_Var_1($4); 
     4490            else 
     4491              { 
     4492                WriteBeginof_SubLoop(); 
     4493              } 
     4494        } 
     4495        line-break 
     4496     ; 
     4497 
     4498 
     4499subroutine-name: TOK_NAME 
     4500     { 
     4501     if (strcmp(subroutinename,"")) 
     4502     { 
     4503     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram 
     4504     old_oldfortran_out=oldfortran_out; 
     4505     } 
     4506     else 
     4507     { 
     4508     old_oldfortran_out=(FILE *)NULL; 
     4509     } 
     4510     strcpy($$,$1);strcpy(subroutinename,$1); 
     4511     } 
     4512     ; 
     4513 
     4514/* R1236 : end-subroutine-stmt */ 
     4515 
     4516end-subroutine-stmt: get_my_position TOK_ENDUNIT opt-tok-subroutine opt-ident close_subroutine 
     4517     line-break 
     4518     ; 
     4519 
     4520close_subroutine: 
     4521          {pos_endsubroutine = my_position; 
    15334522            GlobalDeclaration = 0 ; 
    15344523            if ( firstpass == 0 && strcasecmp(subroutinename,"") ) 
     
    15464535                        insubroutinedeclare = 0 ; 
    15474536                        pos_cur = setposcur(); 
    1548                         closeandcallsubloopandincludeit_0(1); 
     4537                        closeandcallsubloopandincludeit_0(suborfun); 
    15494538                        functiondeclarationisdone = 0; 
    15504539                    } 
     
    15654554            } 
    15664555            strcpy(subroutinename,""); 
    1567         } 
    1568       | word_endprogram opt_name 
    1569         { 
    1570             insubroutinedeclare = 0; 
    1571             inprogramdeclare = 0; 
    1572             pos_cur = setposcur(); 
    1573             closeandcallsubloopandincludeit_0(3); 
    1574             functiondeclarationisdone = 0; 
    1575             strcpy(subroutinename,""); 
    1576         } 
    1577       | word_endsubroutine opt_name 
    1578         { 
    1579             if ( strcasecmp(subroutinename,"") ) 
    1580             { 
    1581                 insubroutinedeclare = 0; 
    1582                 pos_cur = setposcur(); 
    1583                 closeandcallsubloopandincludeit_0(1); 
    1584                 functiondeclarationisdone = 0; 
    1585                 strcpy(subroutinename,""); 
    1586             } 
    1587         } 
    1588       | word_endfunction opt_name 
    1589         { 
    1590             insubroutinedeclare = 0; 
    1591             pos_cur = setposcur(); 
    1592             closeandcallsubloopandincludeit_0(0); 
    1593             functiondeclarationisdone = 0; 
    1594             strcpy(subroutinename,""); 
    1595         } 
    1596       | TOK_ENDMODULE opt_name 
    1597         { 
    1598             /* if we never meet the contains keyword               */ 
    1599             if ( firstpass == 0 ) 
    1600             { 
    1601                 RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module" 
    1602                 if ( inmoduledeclare && ! aftercontainsdeclare ) 
    1603                 { 
    1604                     Write_Closing_Module(1); 
    1605                 } 
    1606                 fprintf(fortran_out,"\n      end module %s\n", curmodulename); 
    1607                 if ( module_declar && insubroutinedeclare == 0 ) 
    1608                 { 
    1609                     fclose(module_declar); 
    1610                 } 
    1611             } 
    1612             inmoduledeclare = 0 ; 
    1613             inmodulemeet = 0 ; 
    1614             aftercontainsdeclare = 1; 
    1615             strcpy(curmodulename, ""); 
    1616             GlobalDeclaration = 0 ; 
    1617         } 
    1618       | if-stmt 
    1619       | where-stmt 
    1620       | TOK_CONTAINS 
     4556            if (strcmp(old_subroutinename,"")) 
     4557            { 
     4558            strcpy(subroutinename,old_subroutinename); 
     4559            strcpy(old_subroutinename,""); 
     4560            oldfortran_out=old_oldfortran_out; 
     4561            insubroutinedeclare=1; 
     4562            } 
     4563        } 
     4564        ; 
     4565opt-tok-subroutine: 
     4566     | TOK_SUBROUTINE 
     4567     ; 
     4568 
     4569opt-dummy-arg-list-par: 
     4570     {if (firstpass) $$=NULL;} 
     4571     | '(' {in_complex_literal=0;} opt-dummy-arg-list ')' 
     4572     {if (firstpass) $$=$3;} 
     4573     ; 
     4574 
     4575opt-dummy-arg-list: 
     4576     {if (firstpass) $$=NULL;} 
     4577     | dummy-arg-list 
     4578     {if (firstpass) $$=$1;} 
     4579     ; 
     4580      
     4581dummy-arg-list: 
     4582        dummy-arg 
     4583        { 
     4584            if ( firstpass == 1 ) 
     4585            { 
     4586                strcpy(nameinttypenameback,nameinttypename); 
     4587                strcpy(nameinttypename,""); 
     4588                curvar = createvar($1,NULL); 
     4589                strcpy(nameinttypename,nameinttypenameback); 
     4590                curlistvar = insertvar(NULL,curvar); 
     4591                $$ = settype("",curlistvar); 
     4592            } 
     4593        } 
     4594      | dummy-arg-list ',' dummy-arg 
     4595        { 
     4596            if ( firstpass == 1 ) 
     4597            { 
     4598                strcpy(nameinttypenameback,nameinttypename); 
     4599                strcpy(nameinttypename,""); 
     4600                curvar = createvar($3,NULL); 
     4601                strcpy(nameinttypename,nameinttypenameback); 
     4602                $$ = insertvar($1,curvar); 
     4603            } 
     4604        } 
     4605      ; 
     4606       
     4607/* R1235: dummy-arg */ 
     4608dummy-arg: dummy-arg-name 
     4609      {strcpy($$,$1);} 
     4610      | '*' 
     4611      {strcpy($$,"*");} 
     4612      ; 
     4613       
     4614/* R1241 : return-stmt */ 
     4615return-stmt : opt-label TOK_RETURN line-break 
     4616     | opt-label TOK_RETURN scalar-int-expr line-break 
     4617     ; 
     4618 
     4619/* R1242 : contains-stmt */ 
     4620contains-stmt: opt-label TOK_CONTAINS 
    16214621        { 
    16224622            if ( inside_type_declare ) break; 
     
    16474647            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input); 
    16484648        } 
    1649       ; 
    1650  
    1651 /* R601 : variable */ 
    1652 //variable : expr 
    1653 //       ; 
    1654  
    1655 /* R734 : assignment-stmt */ 
    1656 // assignment-stmt: variable '=' expr 
    1657 //       ; 
    1658 assignment-stmt: expr 
    1659       ; 
    1660  
    1661 /* R741 : where-stmt */ 
    1662 where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt 
    1663       ; 
    1664  
    1665 /* R742 : where-construct */ 
    1666 where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt 
    1667       ; 
    1668  
    1669 opt-where-body-construct: 
    1670       | opt-where-body-construct where-body-construct line-break 
    1671       ; 
    1672  
    1673 opt-masked-elsewhere-construct : 
    1674       | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct 
    1675       ; 
    1676  
    1677 opt-elsewhere-construct: 
    1678       | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct 
    1679       ; 
    1680  
    1681 /* R743 : where-construct-stmt */ 
    1682 where-construct-stmt: 
    1683         TOK_WHERE '(' mask-expr ')' 
    1684       ; 
    1685  
    1686 /* R744 : where-body-construct */ 
    1687 where-body-construct: where-assignment-stmt 
    1688       | where-stmt 
    1689       | where-construct 
    1690       ; 
    1691  
    1692 /* R745 : where-assignment-stmt */ 
    1693 where-assignment-stmt: assignment-stmt 
    1694       ; 
    1695  
    1696 /* R746 : mask-expr */ 
    1697 mask-expr: expr 
    1698       ; 
    1699  
    1700 /* R747 : masked-elsewhere-stmt */ 
    1701 masked-elsewhere-stmt: 
    1702         TOK_ELSEWHEREPAR mask-expr ')' 
    1703       | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME 
    1704       ; 
    1705  
    1706 /* R748: elsewhere-stmt */ 
    1707 elsewhere-stmt: 
    1708         TOK_ELSEWHERE 
    1709       | TOK_ELSEWHERE TOK_NAME 
    1710       ; 
    1711  
    1712 /* R749: end-where-stmt */ 
    1713 end-where-stmt: 
    1714         TOK_ENDWHERE 
    1715       | TOK_ENDWHERE TOK_NAME 
    1716       ; 
    1717  
    1718 /* R752 : forall-header */ 
    1719 forall-header : 
    1720      ; 
    1721  
    1722 /* R801 : block */ 
    1723 block: 
    1724       |block execution-part-construct 
    1725       |block execution-part-construct line-break 
    1726       ; 
    1727  
    1728 /* R813 : do-construct */ 
    1729 do-construct: 
    1730         block-do-construct 
    1731       ; 
    1732  
    1733 /* R814 : block-do-construct */ 
    1734 block-do-construct: 
    1735         do-stmt line-break do-block end-do 
    1736       ; 
    1737  
    1738 /* R815 : do-stmt */ 
    1739 do-stmt: 
    1740         label-do-stmt 
    1741       | nonlabel-do-stmt 
    1742       ; 
    1743  
    1744 /* R816 : label-do-stmt */ 
    1745 label-do-stmt: 
    1746         TOK_NAME ':' TOK_PLAINDO label 
    1747       |              TOK_PLAINDO label 
    1748       | TOK_NAME ':' TOK_PLAINDO label loop-control 
    1749       |              TOK_PLAINDO label loop-control 
    1750       ; 
    1751  
    1752 /* R817 : nonlabel-do-stmt */ 
    1753 nonlabel-do-stmt: 
    1754         TOK_NAME ':' TOK_PLAINDO 
    1755       |              TOK_PLAINDO 
    1756       | TOK_NAME ':' TOK_PLAINDO loop-control 
    1757       |              TOK_PLAINDO loop-control 
    1758       ; 
    1759  
    1760 /* R818 : loop-control */ 
    1761 loop-control: 
    1762         opt_comma do-variable '=' expr ',' expr 
    1763       | opt_comma do-variable '=' expr ',' expr ',' expr 
    1764       | opt_comma TOK_WHILE '(' expr ')' 
    1765       | opt_comma TOK_CONCURRENT forall-header 
    1766       ; 
    1767  
    1768 /* R819 : do-variable */ 
    1769 do-variable : ident 
    1770      ; 
    1771  
    1772 /* R820 : do-block */ 
    1773 do-block: block 
    1774      ; 
    1775  
    1776 /* R821 : end-do */ 
    1777 end-do: end-do-stmt 
    1778      | continue-stmt 
    1779      ; 
    1780  
    1781 /* R822 : end-do-stmt */ 
    1782 end-do-stmt: 
    1783         TOK_ENDDO 
    1784       | TOK_ENDDO TOK_NAME 
    1785       ; 
    1786  
    1787 /* R832 : if-construct */ 
    1788 if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt 
    1789       ; 
    1790  
    1791 opt-else-if-stmt-block: 
    1792       | else-if-stmt-block 
    1793       | opt-else-if-stmt-block else-if-stmt-block 
    1794       ; 
    1795  
    1796 else-if-stmt-block: 
    1797         else-if-stmt line-break block 
    1798       ; 
    1799  
    1800 opt-else-stmt-block: 
    1801       | else-stmt-block 
    1802       | opt-else-stmt-block else-if-stmt-block 
    1803       ; 
    1804  
    1805 else-stmt-block: else-stmt line-break block 
    1806         ; 
    1807  
    1808 /* R833 : if-then-stmt */ 
    1809 if-then-stmt: 
    1810          TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN 
    1811       |               TOK_LOGICALIF '(' expr ')' TOK_THEN 
    1812       ; 
    1813  
    1814 /* R834 : else-if-stmt */ 
    1815 else-if-stmt: 
    1816         TOK_ELSEIF '(' expr ')' TOK_THEN 
    1817       | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME 
    1818       ; 
    1819  
    1820 /* R835 : else-stmt */ 
    1821 else-stmt: 
    1822         TOK_ELSE 
    1823       | TOK_ELSE TOK_NAME 
    1824       ; 
    1825  
    1826 /* R836 : end-if-stmt */ 
    1827 end-if-stmt: 
    1828         TOK_ENDIF 
    1829       | TOK_ENDIF TOK_NAME 
    1830       ; 
    1831  
    1832 /* R837 : if-stmt */ 
    1833 if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt 
    1834         ; 
    1835  
    1836 /* R838 : case-construct */ 
    1837 case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt 
    1838         ; 
    1839  
    1840 opt_case-stmt-block: 
    1841         | case-stmt-block 
    1842         | opt_case-stmt-block case-stmt-block 
    1843         ; 
    1844  
    1845 case-stmt-block: case-stmt line-break block 
    1846         ; 
    1847  
    1848 /* R839 : select-case-stmt */ 
    1849 select-case-stmt : 
    1850           TOK_NAME ':' TOK_SELECTCASE '(' expr ')' 
    1851         |              TOK_SELECTCASE '(' expr ')' 
    1852         ; 
    1853  
    1854 /* R840 : case-stmt */ 
    1855 case-stmt: 
    1856           TOK_CASE case-selector 
    1857         | TOK_CASE case-selector TOK_NAME 
    1858         ; 
    1859  
    1860 /* R840 : end-select-stmt */ 
    1861 end-select-stmt: 
    1862           TOK_ENDSELECT 
    1863         | TOK_ENDSELECT TOK_NAME 
    1864         ; 
    1865  
    1866 /* R843 : case-selector */ 
    1867 case-selector: 
    1868           '(' case-value-range-list ')' 
    1869         | TOK_DEFAULT 
    1870         ; 
    1871  
    1872 case-value-range-list: 
    1873         case-value-range 
    1874       | case-value-range-list ',' case-value-range 
    1875       ; 
    1876  
    1877 /* R844: case-value-range */ 
    1878 case-value-range : 
    1879         case-value 
    1880       | case-value ':' 
    1881       | ':' case-value 
    1882       | case-value ':' case-value 
    1883       ; 
    1884  
    1885 /* R845 : case-value */ 
    1886 case-value: expr 
    1887         ; 
    1888  
    1889 /* R854 : continue-stmt */ 
    1890 continue-stmt: TOK_CONTINUE 
    1891         ; 
    1892  
    1893 /* R1001 : format-stmt */ 
    1894 format-stmt: TOK_FORMAT 
    1895         ; 
    1896  
    1897 word_endsubroutine : 
    1898         TOK_ENDSUBROUTINE 
    1899         { 
    1900             strcpy($$,$1); 
    1901             pos_endsubroutine = setposcur()-strlen($1); 
    1902             functiondeclarationisdone = 0; 
    1903         } 
    1904       ; 
    1905 word_endunit : 
    1906         TOK_ENDUNIT 
    1907         { 
    1908             strcpy($$,$1); 
    1909             pos_endsubroutine = setposcur()-strlen($1); 
    1910         } 
    1911       ; 
    1912 word_endprogram : 
    1913         TOK_ENDPROGRAM 
    1914         { 
    1915             strcpy($$,$1); 
    1916             pos_endsubroutine = setposcur()-strlen($1); 
    1917         } 
    1918       ; 
    1919 word_endfunction : 
    1920         TOK_ENDFUNCTION 
    1921         { 
    1922             strcpy($$,$1); 
    1923             pos_endsubroutine = setposcur()-strlen($1); 
    1924         } 
    1925       ; 
     4649        line-break 
     4650     ; 
     4651 
     4652/* R1243 : stmt-function-stmt */ 
     4653stmt-function-stmt: TOK_NAME '(' opt-dummy-arg-name-list ')' '=' expr line-break 
     4654     ; 
    19264655 
    19274656opt_name : '\n'  {strcpy($$,"");} 
     
    19754704      | callarglist 
    19764705      ; 
    1977 keywordcall : 
     4706keywordcall: 
    19784707        before_call TOK_FLUSH 
    19794708      | before_call TOK_NAME 
     
    20004729      ; 
    20014730before_call : TOK_CALL  { pos_curcall=setposcur()-4; } 
     4731      | label TOK_CALL  { pos_curcall=setposcur()-4; } 
    20024732      ; 
    20034733callarglist : 
     
    20214751      ; 
    20224752 
    2023 option_inlist : 
    2024       | inlist 
    2025       ; 
    2026 option_read : 
    2027         ioctl option_inlist 
    2028       | infmt opt_inlist 
    2029       ; 
    2030 opt_inlist : 
    2031       | ',' inlist 
    2032       ; 
     4753option_io_1 : 
     4754        infmt ',' inlist 
     4755      | infmt 
     4756 
     4757option_io_2 : 
     4758        ioctl outlist 
     4759      | ioctl 
     4760 
    20334761ioctl : '(' ctllist ')' 
    20344762      ; 
     
    20584786      ; 
    20594787iofctl : 
    2060         TOK_OPEN 
    2061       | TOK_CLOSE 
    2062       | TOK_FLUSH 
     4788      TOK_FLUSH 
    20634789      ; 
    20644790infmt :  unpar_fexpr 
     
    20664792      ; 
    20674793 
    2068 read :  TOK_READ 
    2069       | TOK_INQUIRE 
    2070       | TOK_PRINT 
     4794write_or_inq : 
     4795        TOK_WRITE 
    20714796      ; 
    20724797 
Note: See TracChangeset for help on using the changeset viewer.