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 6758 for branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c – NEMO

Ignore:
Timestamp:
2016-06-29T17:49:04+02:00 (8 years ago)
Author:
kingr
Message:

Merged branches/UKMO/nemo_v3_6_STABLE_copy@6237

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c

    r6757 r6758  
    4343/* This subroutine is used to initialized grid dimension variable             */ 
    4444/******************************************************************************/ 
    45 /*                                                                            */ 
    46 /*                                                                            */ 
    47 /*                                                                            */ 
    48 /******************************************************************************/ 
    49 void initdimprob(int dimprobmod, char * nx, char * ny,char* nz) 
    50 { 
    51   dimprob = dimprobmod; 
    52  
    53   strcpy(nbmaillesX,nx); 
    54   strcpy(nbmaillesY,ny); 
    55   strcpy(nbmaillesZ,nz); 
    56 } 
    57  
    58 /******************************************************************************/ 
    59 /*                      Variableshouldberemove                                */ 
     45void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz) 
     46{ 
     47    dimprob = dimprobmod; 
     48 
     49    strcpy(nbmaillesX, nx); 
     50    strcpy(nbmaillesY, ny); 
     51    strcpy(nbmaillesZ, nz); 
     52} 
     53 
     54/******************************************************************************/ 
     55/*                      Variableshouldberemoved                               */ 
    6056/******************************************************************************/ 
    6157/* Firstpass 0                                                                */ 
    … …  
    6561/*                                                                            */ 
    6662/******************************************************************************/ 
    67 int Variableshouldberemove(char *nom) 
    68 { 
    69  
    70    int remove; 
    71  
    72    remove = 0 ; 
    73  
    74    if ( remove == 0 && Agrif_in_Tok_NAME(nom) == 1 ) remove = 1 ; 
    75  
    76    return remove; 
     63int Variableshouldberemoved(const char *nom) 
     64{ 
     65    return Agrif_in_Tok_NAME(nom); 
    7766} 
    7867 
    … …  
    9786        /* Now we should give the definition of the variable in the           */ 
    9887        /* table List_UsedInSubroutine_Var                                    */ 
    99         printf("QDKFLSDFKSLDF\n"); 
    100         strcpy(curvar->var->v_typevar,newvar->var->v_typevar); 
    101         strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar); 
    102         curvar->var->v_nbdim = newvar->var->v_nbdim; 
     88        strcpy(curvar->var->v_typevar, newvar->var->v_typevar); 
     89        strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar); 
     90        curvar->var->v_nbdim          = newvar->var->v_nbdim; 
    10391        curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven; 
    104         curvar->var->v_allocatable = newvar->var->v_allocatable; 
    105         curvar->var->v_target = newvar->var->v_target; 
     92        curvar->var->v_allocatable    = newvar->var->v_allocatable; 
     93        curvar->var->v_target         = newvar->var->v_target; 
     94        curvar->var->v_catvar         = newvar->var->v_catvar; 
    10695        curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare; 
    107         curvar->var->v_indicetabvars = newvar->var->v_indicetabvars; 
    108         strcpy(curvar->var->v_nameinttypename,newvar->var->v_nameinttypename); 
    109         strcpy(curvar->var->v_precision,newvar->var->v_precision); 
    110         strcpy(curvar->var->v_readedlistdimension, 
    111                                             newvar->var->v_readedlistdimension); 
    112         strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile); 
     96        curvar->var->v_indicetabvars  = newvar->var->v_indicetabvars; 
     97        strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename); 
     98        strcpy(curvar->var->v_precision, newvar->var->v_precision); 
     99        strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension); 
     100        strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile); 
    113101     } 
    114102     else 
    … …  
    128116  present = 0; 
    129117  newvar = listin; 
     118 
    130119  while ( newvar && present == 0 ) 
    131120  { 
    132121     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) && 
    133           !strcasecmp(newvar->var->v_subroutinename, 
    134                                     curvar->var->v_subroutinename) 
    135         ) 
     122          !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) ) 
    136123     { 
    137124        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile); 
    138         CopyRecord(curvar->var,newvar->var); 
     125        Merge_Variables(curvar->var,newvar->var); 
    139126        present = 1; 
    140127     } 
    … …  
    156143     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) ) 
    157144     { 
    158         CopyRecord(curvar->var,newvar->var); 
     145        Merge_Variables(curvar->var,newvar->var); 
    159146        present = 1; 
    160147     } 
    … …  
    170157/* This subroutine is to know if a variable is global                         */ 
    171158/******************************************************************************/ 
    172 void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse) 
     159void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse) 
    173160{ 
    174161  int Globalite; 
    … …  
    178165  listvar *newvar2; 
    179166  int out; 
    180   char truename[LONG_C];   
     167  char truename[LONG_VNAME]; 
    181168 
    182169  Globalite = 1; 
    … …  
    195182       strcpy(truename,newvar->c_namepointedvar); 
    196183     } 
    197       
     184 
    198185     out = 0; 
    199186     newvar2 = tempo; 
    … …  
    227214  { 
    228215     pos_end = setposcurname(fileout); 
    229      RemoveWordSET_0(fileout,oldposcuruse, 
    230                                 pos_end-oldposcuruse); 
    231                                    
     216     RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse); 
     217 
    232218     newvar = listin; 
    233219     while ( newvar ) 
    234220     { 
    235         fprintf(fileout,"      USE %s, ONLY : %s \n",module,newvar->c_namevar); 
     221        fprintf(fileout,"      use %s, only : %s \n",module,newvar->c_namevar); 
    236222        newvar = newvar->suiv; 
    237223     } 
    … …  
    239225} 
    240226 
    241  
    242 void Remove_Word_Contains_0() 
    243 { 
    244    if ( firstpass == 0 ) 
    245    { 
    246       RemoveWordCUR_0(fortranout,(long)(-9),9); 
    247    } 
    248 } 
    249  
    250 void Remove_Word_end_module_0(int modulenamelength) 
    251 { 
    252    if ( firstpass == 0 ) 
    253    { 
    254       RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12), 
    255                                          modulenamelength+11); 
    256    } 
    257 } 
    258  
    259 void Write_Word_Contains_0() 
    260 { 
    261    if ( firstpass == 0 ) 
    262    { 
    263       fprintf(fortranout,"\n      contains\n"); 
    264    } 
    265 } 
    266  
    267  
    268227void Write_Word_end_module_0() 
    269228{ 
    270    if ( firstpass == 0 ) 
    271    { 
    272       fprintf(fortranout,"\n      end module %s",curmodulename); 
    273    } 
    274 } 
    275  
    276 void Add_Subroutine_For_Alloc(char *nom) 
     229    if ( firstpass == 0 ) 
     230    { 
     231        fprintf(fortran_out,"\n      end module %s",curmodulename); 
     232    } 
     233} 
     234 
     235void Add_Subroutine_For_Alloc(const char *nom) 
    277236{ 
    278237   listnom *parcours; 
    … …  
    280239   int out; 
    281240 
    282    newvar = (listnom *)malloc(sizeof(listnom)); 
     241   newvar = (listnom*) calloc(1, sizeof(listnom)); 
    283242   strcpy(newvar->o_nom,nom); 
    284    Save_Length(nom,23); 
    285243   newvar->suiv = NULL; 
    286244 
    … …  
    306264} 
    307265 
    308  
    309 void Write_Alloc_Subroutine_0() 
    310 { 
    311    listnom *parcours_nom; 
    312    listnom *parcours_nomprec; 
    313    int out; 
    314    char ligne[LONG_C]; 
    315  
    316    if ( firstpass == 0 ) 
    317    { 
    318       parcours_nomprec = (listnom *)NULL; 
    319       parcours_nom = List_NameOfModule; 
    320       out = 0 ; 
    321       while ( parcours_nom && out == 0 ) 
    322       { 
    323          /*                                                                   */ 
    324          if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1; 
    325          else parcours_nom = parcours_nom -> suiv; 
    326       } 
    327       if ( out == 1 ) 
    328       { 
    329          if ( parcours_nom->o_val == 1 ) 
    330          { 
    331             strcpy (ligne, "\n      PUBLIC Alloc_agrif_"); 
    332             strcat (ligne, curmodulename); 
    333             strcat (ligne, "\n"); 
    334             convert2lower(ligne); 
    335             fprintf(fortranout,ligne); 
    336          } 
    337       } 
    338       Write_Word_Contains_0(); 
    339       if ( out == 1 ) 
    340       { 
    341          if ( parcours_nom->o_val == 1 ) 
    342          { 
    343             sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)", 
    344                                                                  curmodulename); 
    345             tofich(fortranout,ligne,1); 
    346             strcpy(ligne,"Use Agrif_Util"); 
    347             tofich(fortranout,ligne,1); 
    348             strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr"); 
    349             tofich(fortranout,ligne,1); 
    350             strcpy(ligne, "INTEGER :: i"); 
    351             tofich (fortranout, ligne,1); 
    352             strcpy (ligne, "\n#include \"alloc_agrif_"); 
    353             strcat (ligne, curmodulename); 
    354             strcat (ligne, ".h\"\n"); 
    355             convert2lower(ligne); 
    356             fprintf(fortranout,ligne); 
    357             strcpy (ligne, "Return"); 
    358             tofich(fortranout,ligne,1); 
    359             sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename); 
    360             tofich(fortranout,ligne,1); 
    361             /* List all Call Alloc_agrif_                                     */ 
     266void Write_Closing_Module(int forend) 
     267{ 
     268    listvar *parcours; 
     269    listnom *parcours_nom; 
     270    listnom *parcours_nomprec; 
     271    variable *v; 
     272    int out = 0; 
     273    int headtypewritten = 0; 
     274    char ligne[LONG_M]; 
     275    int changeval; 
     276 
     277    // Write Global Parameter Declaration 
     278    parcours = List_GlobalParameter_Var; 
     279    while( parcours ) 
     280    { 
     281        if ( !strcasecmp(parcours->var->v_modulename, curmodulename) ) 
     282        { 
     283            WriteVarDeclaration(parcours->var, module_declar, 0, 1); 
     284        } 
     285        parcours = parcours -> suiv; 
     286    } 
     287 
     288    // Write Global Type declaration 
     289    parcours = List_Global_Var; 
     290    while( parcours ) 
     291    { 
     292        v = parcours->var; 
     293        if ( !strcasecmp(v->v_modulename, curmodulename) && 
     294             !strcasecmp(v->v_typevar, "type") ) 
     295        { 
     296            if ( headtypewritten == 0 ) 
     297            { 
     298                fprintf(fortran_out, "\n      type Agrif_%s\n", curmodulename); 
     299                headtypewritten = 1; 
     300            } 
     301            changeval = 0; 
     302            if ( v->v_allocatable ) 
     303            { 
     304                changeval = 1; 
     305                v->v_allocatable = 0; 
     306                v->v_pointerdeclare = 1; 
     307            } 
     308            WriteVarDeclaration(v, fortran_out, 0, 0); 
     309            if ( changeval ) 
     310            { 
     311                v->v_allocatable = 1; 
     312                v->v_pointerdeclare = 0; 
     313            } 
     314            out = 1; 
     315        } 
     316        parcours = parcours -> suiv; 
     317    } 
     318    if (out == 1) 
     319    { 
     320        fprintf(fortran_out, "      end type Agrif_%s\n", curmodulename); 
     321        sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename); 
     322        tofich(fortran_out,ligne,1); 
     323        fprintf(fortran_out, "      public :: Agrif_%s\n", curmodulename); 
     324        fprintf(fortran_out, "      public :: Agrif_%s_var\n", curmodulename); 
     325    } 
     326 
     327    // Write NotGridDepend declaration 
     328    parcours = List_NotGridDepend_Var; 
     329    while( parcours ) 
     330    { 
     331        if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
     332        { 
     333            WriteVarDeclaration(parcours->var, fortran_out, 0, 1); 
     334        } 
     335        parcours = parcours -> suiv; 
     336    } 
     337 
     338    // Write Alloc_agrif_'modulename' subroutine 
     339    parcours_nomprec = (listnom*) NULL; 
     340    parcours_nom = List_NameOfModule; 
     341    out = 0 ; 
     342    while ( parcours_nom && out == 0 ) 
     343    { 
     344        if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1; 
     345        else parcours_nom = parcours_nom -> suiv; 
     346    } 
     347    if ( ! out ) 
     348    { 
     349        printf("#\n# Write_Closing_Module : OUT == 0   *** /!\\ ***\n"); 
     350        printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n"); 
     351    } 
     352    if ( out ) 
     353    { 
     354        if ( parcours_nom->o_val == 1 ) 
     355        { 
     356            fprintf(fortran_out,"\n      public :: Alloc_agrif_%s\n",curmodulename); 
     357        } 
     358        if ( (forend == 0) || (parcours_nom->o_val == 1) ) 
     359        { 
     360           fprintf(fortran_out,"\n      contains\n"); 
     361        } 
     362        if ( parcours_nom->o_val == 1 ) 
     363        { 
     364            fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename); 
     365            fprintf(fortran_out, "          use Agrif_Util\n"); 
     366            fprintf(fortran_out, "          type(Agrif_grid), pointer :: Agrif_Gr\n"); 
     367            fprintf(fortran_out, "          integer :: i\n"); 
     368            fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename); 
     369            fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", curmodulename); 
    362370            Add_Subroutine_For_Alloc(curmodulename); 
    363          } 
    364          else 
    365          { 
     371        } 
     372        else 
     373        { 
    366374            parcours_nom = List_Subroutine_For_Alloc; 
    367375            out = 0; 
    368376            while ( parcours_nom && out == 0 ) 
    369377            { 
    370                if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1; 
    371                else 
    372                { 
    373                   parcours_nomprec = parcours_nom; 
    374                   parcours_nom = parcours_nom->suiv; 
    375                } 
    376             } 
    377             if ( out == 1 ) 
    378             { 
    379                if ( parcours_nom == List_Subroutine_For_Alloc) 
    380                { 
    381                   List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv; 
    382                } 
    383                else 
    384                { 
    385                   parcours_nomprec->suiv = parcours_nom->suiv; 
    386                   parcours_nom = parcours_nomprec->suiv ; 
    387                } 
    388             } 
    389          } 
    390       } 
    391    } 
    392 } 
    393  
    394  
    395 void Write_Alloc_Subroutine_For_End_0() 
    396 { 
    397    listnom *parcours_nom; 
    398    listnom *parcours_nomprec; 
    399    int out; 
    400    char ligne[LONG_C]; 
    401  
    402    if ( firstpass == 0 ) 
    403    { 
    404       parcours_nomprec = (listnom *)NULL; 
    405       parcours_nom = List_NameOfModule; 
    406       out = 0 ; 
    407       while ( parcours_nom && out == 0 ) 
    408       { 
    409          /*                                                                   */ 
    410          if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1; 
    411          else parcours_nom = parcours_nom -> suiv; 
    412       } 
    413       if ( out == 1 ) 
    414       { 
    415          if ( parcours_nom->o_val == 1 ) 
    416          { 
    417             strcpy (ligne, "\n      PUBLIC Alloc_agrif_"); 
    418             strcat (ligne, curmodulename); 
    419             strcat (ligne, "\n"); 
    420             convert2lower(ligne); 
    421             fprintf(fortranout,ligne); 
    422             strcpy (ligne, "\n      contains\n"); 
    423             fprintf(fortranout,ligne); 
    424             sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)", 
    425                                                                  curmodulename); 
    426             tofich(fortranout,ligne,1); 
    427             strcpy(ligne,"Use Agrif_Util"); 
    428             tofich(fortranout,ligne,1); 
    429             strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr"); 
    430             tofich(fortranout,ligne,1); 
    431             strcpy(ligne, "INTEGER :: i"); 
    432             tofich (fortranout, ligne,1); 
    433             strcpy (ligne, "\n#include \"alloc_agrif_"); 
    434             strcat (ligne, curmodulename); 
    435             strcat (ligne, ".h\"\n"); 
    436             convert2lower(ligne); 
    437             fprintf(fortranout,ligne); 
    438             strcpy (ligne, "Return"); 
    439             tofich(fortranout,ligne,1); 
    440             sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename); 
    441             tofich(fortranout,ligne,1); 
    442             /* List all Call Alloc_agrif                                      */ 
    443             Add_Subroutine_For_Alloc(parcours_nom->o_nom); 
    444          } 
    445          else 
    446          { 
    447             parcours_nom = List_Subroutine_For_Alloc; 
    448             out = 0; 
    449             while ( parcours_nom && out == 0 ) 
    450             { 
    451                if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1; 
    452                else 
    453                { 
    454                   parcours_nomprec = parcours_nom; 
    455                   parcours_nom = parcours_nom->suiv; 
    456                } 
    457             } 
    458             if ( out == 1 ) 
    459             { 
    460                if ( parcours_nom == List_Subroutine_For_Alloc) 
    461                { 
    462                   List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv; 
    463                } 
    464                else 
    465                { 
    466                   parcours_nomprec->suiv = parcours_nom->suiv; 
    467                   parcours_nom = parcours_nomprec->suiv ; 
    468                } 
    469             } 
    470          } 
    471       } 
    472    } 
    473 } 
    474  
    475 void Write_GlobalParameter_Declaration_0() 
    476 { 
    477    listvar *parcours; 
    478  
    479    if ( firstpass == 0 ) 
    480    { 
    481       parcours = List_GlobalParameter_Var; 
    482       while( parcours ) 
    483       { 
    484          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    485          { 
    486             writevardeclaration(parcours,module_declar,0,1); 
    487          } 
    488          parcours = parcours -> suiv; 
    489       } 
    490    } 
    491 } 
    492  
    493 void Write_GlobalType_Declaration_0() 
    494 { 
    495    listvar *parcours; 
    496    int out = 0; 
    497    int headtypewritten = 0; 
    498    char ligne[LONGNOM]; 
    499    int changeval; 
    500  
    501    if ( firstpass == 0 ) 
    502    { 
    503       parcours = List_Global_Var; 
    504       while( parcours ) 
    505       { 
    506          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    507          { 
    508            if (!strcasecmp(parcours->var->v_typevar,"type")) 
    509            { 
    510             out = 1; 
    511             if (headtypewritten == 0) 
    512               { 
    513 /*RB*/ 
    514                 sprintf (ligne, "Module_DeclarType_%s.h",curmodulename); 
    515                 module_declar_type = associate(ligne); 
    516                 sprintf (ligne, " "); 
    517                 tofich (module_declar_type, ligne,1); 
    518                 sprintf(ligne,"TYPE :: Agrif_%s",curmodulename); 
    519                 tofich(module_declar_type,ligne,1); 
    520                 headtypewritten = 1; 
    521 /*RBend*/ 
    522               } 
    523             changeval = 0; 
    524             if (parcours->var->v_allocatable == 1) 
    525              { 
    526                changeval = 1; 
    527                parcours->var->v_allocatable = 0; 
    528                parcours->var->v_pointerdeclare = 1; 
    529              } 
    530 /*RB*/ 
    531             writevardeclaration(parcours,module_declar_type,0,0); 
    532 /*RBend*/ 
    533             if (changeval == 1) 
    534               { 
    535                parcours->var->v_allocatable = 1; 
    536                parcours->var->v_pointerdeclare = 0; 
    537               } 
    538             } 
    539          } 
    540          parcours = parcours -> suiv; 
    541       } 
    542       if (out == 1) 
    543         { 
    544 /*RB*/ 
    545                 sprintf(ligne,"END TYPE Agrif_%s",curmodulename); 
    546                 tofich(module_declar_type,ligne,1); 
    547                 sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename);  
    548                 tofich(module_declar_type,ligne,1); 
    549                 sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename);  
    550                 tofich(module_declar_type,ligne,1); 
    551                 sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename);  
    552                 tofich(module_declar_type,ligne,1); 
    553 /*RBend*/ 
    554         } 
    555    } 
    556 } 
    557  
    558 void Write_NotGridDepend_Declaration_0() 
    559 { 
    560    listvar *parcours; 
    561  
    562    if ( firstpass == 0 ) 
    563    { 
    564       parcours = List_NotGridDepend_Var; 
    565       while( parcours ) 
    566       { 
    567          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    568          { 
    569             writevardeclaration(parcours,fortranout,0,1); 
    570          } 
    571          parcours = parcours -> suiv; 
    572       } 
    573    } 
     378                if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1; 
     379                else 
     380                { 
     381                    parcours_nomprec = parcours_nom; 
     382                    parcours_nom = parcours_nom->suiv; 
     383                } 
     384            } 
     385            if ( out ) 
     386            { 
     387                if ( parcours_nom == List_Subroutine_For_Alloc) 
     388                { 
     389                    List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv; 
     390                } 
     391                else 
     392                { 
     393                    parcours_nomprec->suiv = parcours_nom->suiv; 
     394                    parcours_nom = parcours_nomprec->suiv ; 
     395                } 
     396            } 
     397        } 
     398    } 
    574399} 
    575400 
    … …  
    669494      if ( !List_Pointer_Var ) 
    670495      { 
    671          newvar = (listname *)malloc(sizeof(listname)); 
    672          strcpy(newvar->n_name,nom); 
    673          Save_Length(nom,20); 
     496         newvar = (listname*) calloc(1, sizeof(listname)); 
     497         strcpy(newvar->n_name, nom); 
    674498         newvar->suiv = NULL; 
    675499         List_Pointer_Var = newvar; 
    … …  
    691515            { 
    692516               /* add the record                                              */ 
    693               newvar = (listname *)malloc(sizeof(listname)); 
     517              newvar = (listname*) calloc(1, sizeof(listname)); 
    694518              strcpy(newvar->n_name,nom); 
    695               Save_Length(nom,20); 
    696519              newvar->suiv = NULL; 
    697520              parcours->suiv = newvar; 
    … …  
    745568      while( parcours && out == 0 ) 
    746569      { 
    747          if ( !strcasecmp(ident,parcours->var->v_nomvar) )  
     570         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
    748571             { 
    749572             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1; 
    … …  
    757580 
    758581/******************************************************************************/ 
    759 /*                          VariableIsNotFunction                             */ 
    760 /******************************************************************************/ 
    761 /*                                                                            */ 
    762 /******************************************************************************/ 
    763 int VariableIsNotFunction(char *ident) 
    764 { 
    765    int out; 
    766    listvar *newvar; 
    767  
    768    out =0; 
    769  
    770    if ( !strcasecmp(ident,"size") || 
    771         !strcasecmp(ident,"if")   || 
    772         !strcasecmp(ident,"max")  || 
    773         !strcasecmp(ident,"min") 
    774       ) 
    775    { 
    776       newvar = List_SubroutineDeclaration_Var; 
    777       while ( newvar && out == 0 ) 
    778       { 
    779          if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) && 
    780               !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1; 
    781          newvar = newvar -> suiv ; 
    782       } 
    783       if ( out == 1 ) out = 0; 
    784       else out = 1; 
    785       /* if it has not been found                                             */ 
    786       if ( out == 1 ) 
    787       { 
    788          out = 0; 
    789          newvar = List_Global_Var; 
    790          while ( newvar && out == 0 ) 
    791          { 
    792             if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1; 
     582/*                          VariableIsFunction                                */ 
     583/******************************************************************************/ 
     584/*                                                                            */ 
     585/******************************************************************************/ 
     586int VariableIsFunction(const char *ident) 
     587{ 
     588    int out; 
     589    listvar *newvar; 
     590 
     591    out = 0; 
     592 
     593    if ( !strcasecmp(ident,"size") || 
     594         !strcasecmp(ident,"if")   || 
     595         !strcasecmp(ident,"max")  || 
     596         !strcasecmp(ident,"min")  ) 
     597    { 
     598        newvar = List_SubroutineDeclaration_Var; 
     599        while ( newvar && out == 0 ) 
     600        { 
     601            if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) && 
     602                 !strcasecmp(ident, newvar->var->v_nomvar) ) 
     603            { 
     604                out = 1; 
     605            } 
    793606            newvar = newvar -> suiv ; 
    794          } 
    795          if ( out == 1 ) out = 0; 
    796          else out = 1; 
    797       } 
    798    } 
    799    /*                                                                         */ 
    800    return out; 
    801 } 
     607        } 
     608        if ( out == 0 ) /* if it has not been found */ 
     609        { 
     610            newvar = List_Global_Var; 
     611            while ( newvar && out == 0 ) 
     612            { 
     613                if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1; 
     614                newvar = newvar -> suiv ; 
     615            } 
     616        } 
     617    } 
     618    return (out == 0); 
     619} 
     620 
     621void dump_var(const variable* var) 
     622{ 
     623    fprintf(stderr, "   var->v_nomvar : %s\n",var->v_nomvar); 
     624    fprintf(stderr, "   var->v_indice : %d\n",var->v_indicetabvars); 
     625    fprintf(stderr, "   var->v_typevar: %s\n",var->v_typevar); 
     626    fprintf(stderr, "   var->v_catvar : %d\n",var->v_catvar); 
     627    fprintf(stderr, "   var->v_modulename: %s\n",var->v_modulename); 
     628    fprintf(stderr, "   var->v_subroutinename: %s\n",var->v_subroutinename); 
     629    fprintf(stderr, "   var->v_commonname: %s\n",var->v_commonname); 
     630    fprintf(stderr, "   var->v_commoninfile: %s\n",var->v_commoninfile); 
     631    fprintf(stderr, "   var->v_nbdim: %d\n",var->v_nbdim); 
     632    fprintf(stderr, "   var->v_common: %d\n",var->v_common); 
     633    fprintf(stderr, "   var->v_module: %d\n",var->v_module); 
     634    fprintf(stderr, "   var->v_initialvalue: %s\n",var->v_initialvalue); 
     635} 
Note: See TracChangeset for help on using the changeset viewer.