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 9817 for branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c – NEMO

Ignore:
Timestamp:
2018-06-21T11:58:42+02:00 (6 years ago)
Author:
dancopsey
Message:

Merged in GO6 package branch up to revision 8356.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c

    r9816 r9817  
    4141void Init_Variable(variable *var) 
    4242{ 
    43    strcpy(var->v_typevar            ,""); 
    44    strcpy(var->v_nomvar             ,""); 
    45    strcpy(var->v_oldname            ,""); 
    46    strcpy(var->v_dimchar            ,""); 
    47    strcpy(var->v_modulename         ,""); 
    48    strcpy(var->v_commonname         ,""); 
    49    strcpy(var->v_vallengspec        ,""); 
    50    strcpy(var->v_nameinttypename    ,""); 
    51    strcpy(var->v_commoninfile       ,""); 
    52    strcpy(var->v_subroutinename     ,""); 
    53    strcpy(var->v_precision          ,""); 
    54    strcpy(var->v_initialvalue       ,""); 
    55    strcpy(var->v_IntentSpec         ,""); 
    56    strcpy(var->v_readedlistdimension,""); 
     43   strcpy(var->v_typevar            , ""); 
     44   strcpy(var->v_nomvar             , ""); 
     45   strcpy(var->v_oldname            , ""); 
     46   strcpy(var->v_dimchar            , ""); 
     47   strcpy(var->v_modulename         , ""); 
     48   strcpy(var->v_commonname         , ""); 
     49   strcpy(var->v_vallengspec        , ""); 
     50   strcpy(var->v_nameinttypename    , ""); 
     51   strcpy(var->v_commoninfile       , ""); 
     52   strcpy(var->v_subroutinename     , ""); 
     53   strcpy(var->v_precision          , ""); 
     54   strcpy(var->v_initialvalue       , ""); 
     55   strcpy(var->v_IntentSpec         , ""); 
     56   strcpy(var->v_readedlistdimension, ""); 
    5757   var->v_nbdim               = 0 ; 
    5858   var->v_common              = 0 ; 
    … …  
    6060   var->v_module              = 0 ; 
    6161   var->v_save                = 0 ; 
     62   var->v_catvar              = 0 ; 
    6263   var->v_VariableIsParameter = 0 ; 
    6364   var->v_PublicDeclare       = 0 ; 
    … …  
    7475   var->v_target              = 0 ; 
    7576   var->v_dimsempty           = 0 ; 
    76    var->v_dimension = (listdim *)NULL; 
     77   var->v_dimension = (listdim *) NULL; 
    7778} 
    7879/******************************************************************************/ 
    … …  
    8990/*                                                                            */ 
    9091/******************************************************************************/ 
    91 listvar * AddListvarToListvar(listvar *l,listvar *glob,int ValueFirstpass) 
    92 { 
    93    listvar *newvar; 
    94    if ( firstpass == ValueFirstpass ) 
    95    { 
    96       if ( !glob) glob = l ; 
    97       else 
    98       { 
    99          newvar=glob; 
    100          while (newvar->suiv) newvar = newvar->suiv; 
    101          newvar->suiv = l; 
    102       } 
    103    } 
    104    return glob; 
     92listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass ) 
     93{ 
     94    listvar *newvar; 
     95    if ( firstpass == ValueFirstpass ) 
     96    { 
     97        if ( !glob ) glob = l; 
     98        else 
     99        { 
     100            newvar = glob; 
     101            while (newvar->suiv) 
     102                newvar = newvar->suiv; 
     103            newvar->suiv = l; 
     104        } 
     105    } 
     106    return glob; 
    105107} 
    106108 
    … …  
    113115/*                                                                            */ 
    114116/******************************************************************************/ 
    115 void CreateAndFillin_Curvar(char *type,variable *curvar) 
    116 { 
    117    if (!strcasecmp(type,"character") && strcasecmp(CharacterSize,"") ) 
    118    { 
    119       strcpy(curvar->v_dimchar,CharacterSize); 
    120       Save_Length(CharacterSize,5); 
    121    } 
    122  
    123   /* On donne la precision de la variable si elle a ete donnee                */ 
    124   curvar->v_c_star = 0; 
    125   if ( c_star == 1 ) curvar->v_c_star = 1; 
    126   /*                                                                          */ 
    127   strcpy(curvar->v_vallengspec,""); 
    128   if ( strcasecmp(vallengspec,"") ) 
    129   { 
    130      strcpy(curvar->v_vallengspec,vallengspec); 
    131      Save_Length(vallengspec,8); 
    132   } 
    133  
    134   strcpy(curvar->v_precision,""); 
    135   if ( strcasecmp(NamePrecision,"") ) 
    136   { 
    137      strcpy(curvar->v_precision,NamePrecision); 
    138      Save_Length(NamePrecision,12); 
    139   } 
    140   /* Si cette variable a ete declaree dans un module on met curvar->module=1  */ 
    141   if ( inmoduledeclare == 1 || SaveDeclare == 1) 
    142   { 
    143       curvar->v_module = 1; 
    144    } 
    145    /* Puis on donne le nom du module dans curvar->v_modulename                */ 
    146    strcpy(curvar->v_modulename,curmodulename); 
    147    Save_Length(curmodulename,6); 
    148    /* Si cette variable a ete initialisee                                     */ 
    149 /*RB*/ 
    150    if ( ! strcmp(InitialValueGiven,"=")  )  
    151 /*RBend*/ 
    152    { 
    153       strcpy(curvar->v_initialvalue,InitValue); 
    154       Save_Length(InitValue,14); 
    155    } 
    156    /* Si cette variable est declaree en save                                  */ 
    157 /*RB*/ 
    158    if (SaveDeclare == 1 &&  !strcasecmp(curvar->v_typevar,"type")) { 
    159 /*RBend*/ 
    160    curvar->v_save = 1; 
    161    } 
    162  
    163    /* Si cette variable est v_allocatable                                     */ 
    164    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; 
    165     
    166    /* Si cette variable est v_targer                                     */ 
    167    if (Targetdeclare == 1 ) curvar->v_target=1; 
    168    /* if INTENT spec has been given                                           */ 
    169    if ( strcasecmp(IntentSpec,"") ) 
    170    { 
    171       strcpy(curvar->v_IntentSpec,IntentSpec); 
    172       Save_Length(IntentSpec,13); 
    173    } 
    174 } 
    175  
     117void CreateAndFillin_Curvar(const char *type, variable *curvar) 
     118{ 
     119    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") ) 
     120    { 
     121        strcpy(curvar->v_dimchar, CharacterSize); 
     122    } 
     123 
     124    /* On donne la precision de la variable si elle a ete donnee                */ 
     125    curvar->v_c_star = 0; 
     126    if ( c_star == 1 )  curvar->v_c_star = 1; 
     127 
     128    strcpy(curvar->v_vallengspec,""); 
     129    if ( strcasecmp(vallengspec,"") ) 
     130    { 
     131        strcpy(curvar->v_vallengspec,vallengspec); 
     132        Save_Length(vallengspec,8); 
     133    } 
     134 
     135    strcpy(curvar->v_precision,""); 
     136    if ( strcasecmp(NamePrecision,"") ) 
     137    { 
     138        strcpy(curvar->v_precision,NamePrecision); 
     139        addprecision_derivedfromkind(curvar); 
     140        Save_Length(NamePrecision,12); 
     141    } 
     142    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */ 
     143    if ( inmoduledeclare == 1 || SaveDeclare == 1 ) 
     144    { 
     145        curvar->v_module = 1; 
     146    } 
     147    /* Puis on donne le nom du module dans curvar->v_modulename                */ 
     148    strcpy(curvar->v_modulename,curmodulename); 
     149    /* Si cette variable a ete initialisee                                     */ 
     150    if (InitialValueGiven == 1 ) 
     151    { 
     152        strcpy(curvar->v_initialvalue,InitValue); 
     153        Save_Length(InitValue,14); 
     154    } 
     155    /* Si cette variable est declaree en save                                  */ 
     156    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1; 
     157 
     158    /* Si cette variable est v_allocatable                                     */ 
     159    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; 
     160 
     161    /* Si cette variable est v_target                                     */ 
     162    if (Targetdeclare == 1 ) curvar->v_target=1; 
     163 
     164    /* if INTENT spec has been given                                           */ 
     165    if ( strcasecmp(IntentSpec,"") ) 
     166    { 
     167        strcpy(curvar->v_IntentSpec,IntentSpec); 
     168        Save_Length(IntentSpec,13); 
     169    } 
     170} 
     171 
     172 
     173void addprecision_derivedfromkind(variable *curvar) 
     174{ 
     175    listnom *parcours; 
     176    char kind[LONG_VNAME]; 
     177    char kind_val[LONG_C]; 
     178 
     179    sscanf(curvar->v_precision, "%100s =", kind_val); 
     180 
     181    if ( !strcasecmp(kind_val, "kind") ) 
     182        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val); 
     183 
     184    parcours = listofkind; 
     185    while (parcours) 
     186    { 
     187        if ( !strcasecmp(parcours->o_nom, kind_val) ) 
     188        { 
     189            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val); 
     190        } 
     191        parcours=parcours->suiv; 
     192    } 
     193} 
    176194 
    177195/******************************************************************************/ 
    … …  
    180198/*                                                                            */ 
    181199/******************************************************************************/ 
    182 void duplicatelistvar(listvar *orig) 
    183 { 
    184    listvar *parcours; 
    185    listvar *tmplistvar; 
    186    listvar *tmplistvarprec; 
    187    listdim *tmplistdim; 
    188    variable *tmpvar; 
    189  
    190    tmplistvarprec = (listvar *)NULL; 
    191    parcours = orig; 
    192    while ( parcours ) 
    193    { 
    194       tmplistvar = (listvar *)malloc(sizeof(listvar)); 
    195       tmpvar = (variable *)malloc(sizeof(variable)); 
    196       /*                                                                      */ 
    197       Init_Variable(tmpvar); 
    198       /*                                                                      */ 
    199       strcpy(tmpvar->v_typevar,parcours->var->v_typevar); 
    200       strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar); 
    201       strcpy(tmpvar->v_oldname,parcours->var->v_oldname); 
    202       strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar); 
    203       if ( parcours->var->v_dimension ) 
    204       { 
    205          tmplistdim = (listdim *)malloc(sizeof(listdim)); 
    206          tmplistdim = parcours->var->v_dimension; 
    207          tmpvar->v_dimension = tmplistdim; 
    208       } 
    209       tmpvar->v_nbdim=parcours->var->v_nbdim; 
    210       tmpvar->v_common=parcours->var->v_common; 
    211       tmpvar->v_positioninblock=parcours->var->v_positioninblock; 
    212       tmpvar->v_module=parcours->var->v_module; 
    213       tmpvar->v_save=parcours->var->v_save; 
    214       tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter; 
    215       printf("QLKDF\n"); 
    216       tmpvar->v_indicetabvars=parcours->var->v_indicetabvars; 
    217       strcpy(tmpvar->v_modulename,parcours->var->v_modulename); 
    218       strcpy(tmpvar->v_commonname,parcours->var->v_commonname); 
    219       strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec); 
    220  
    221       strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename); 
    222              
    223       tmpvar->v_pointedvar=parcours->var->v_pointedvar; 
    224       strcpy(tmpvar->v_commoninfile,mainfile); 
    225       Save_Length(mainfile,10); 
    226       strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename); 
    227       tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven; 
    228       tmpvar->v_c_star=parcours->var->v_c_star; 
    229       strcpy(tmpvar->v_precision,parcours->var->v_precision); 
    230       strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue); 
    231       tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare; 
    232       tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare; 
    233       tmpvar->v_allocatable=parcours->var->v_allocatable; 
    234       tmpvar->v_target=parcours->var->v_target; 
    235       strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec); 
    236       tmpvar->v_dimsempty=parcours->var->v_dimsempty; 
    237       strcpy(tmpvar->v_readedlistdimension, 
    238                                           parcours->var->v_readedlistdimension); 
    239       /*                                                                      */ 
    240       tmplistvar->var = tmpvar; 
    241       tmplistvar->suiv = NULL; 
    242       /*                                                                      */ 
    243       if ( !listduplicated ) 
    244       { 
    245          listduplicated = tmplistvar; 
    246          tmplistvarprec = listduplicated; 
    247       } 
    248       else 
    249       { 
    250          tmplistvarprec->suiv = tmplistvar; 
    251          tmplistvarprec = tmplistvar; 
    252       } 
    253       /*                                                                      */ 
    254       parcours = parcours->suiv; 
    255    } 
    256 } 
     200// void duplicatelistvar(listvar *orig) 
     201// { 
     202//    listvar *parcours; 
     203//    listvar *tmplistvar; 
     204//    listvar *tmplistvarprec; 
     205//    listdim *tmplistdim; 
     206//    variable *tmpvar; 
     207// 
     208//    tmplistvarprec = (listvar *)NULL; 
     209//    parcours = orig; 
     210//    while ( parcours ) 
     211//    { 
     212//       tmplistvar = (listvar *)calloc(1,sizeof(listvar)); 
     213//       tmpvar = (variable *)calloc(1,sizeof(variable)); 
     214//       /*                                                                      */ 
     215//       Init_Variable(tmpvar); 
     216//       /*                                                                      */ 
     217//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar); 
     218//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar); 
     219//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname); 
     220//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar); 
     221//       if ( parcours->var->v_dimension ) 
     222//       { 
     223//          tmplistdim = (listdim*) calloc(1,sizeof(listdim)); 
     224//          tmplistdim = parcours->var->v_dimension; 
     225//          tmpvar->v_dimension = tmplistdim; 
     226//       } 
     227//       tmpvar->v_nbdim  = parcours->var->v_nbdim; 
     228//       tmpvar->v_common = parcours->var->v_common; 
     229//       tmpvar->v_module = parcours->var->v_module; 
     230//       tmpvar->v_save   = parcours->var->v_save; 
     231//       tmpvar->v_positioninblock = parcours->var->v_positioninblock; 
     232//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter; 
     233//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars; 
     234//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar; 
     235//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven; 
     236//       tmpvar->v_c_star = parcours->var->v_c_star; 
     237//       tmpvar->v_catvar = parcours->var->v_catvar; 
     238//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare; 
     239//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare; 
     240//       tmpvar->v_allocatable = parcours->var->v_allocatable; 
     241//       tmpvar->v_target      = parcours->var->v_target; 
     242//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty; 
     243//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename); 
     244//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname); 
     245//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec); 
     246//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename); 
     247//       strcpy(tmpvar->v_commoninfile, cur_filename); 
     248//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename); 
     249//       strcpy(tmpvar->v_precision, parcours->var->v_precision); 
     250//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue); 
     251//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec); 
     252//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension); 
     253// 
     254//       tmplistvar->var = tmpvar; 
     255//       tmplistvar->suiv = NULL; 
     256// 
     257//       if ( !listduplicated ) 
     258//       { 
     259//          listduplicated = tmplistvar; 
     260//          tmplistvarprec = listduplicated; 
     261//       } 
     262//       else 
     263//       { 
     264//          tmplistvarprec->suiv = tmplistvar; 
     265//          tmplistvarprec = tmplistvar; 
     266//       } 
     267//       parcours = parcours->suiv; 
     268//    } 
     269// } 
    257270 
    258271/******************************************************************************/ 
    … …  
    273286   listdim *parcours ; 
    274287 
    275    newdim=(listdim *) malloc (sizeof (listdim)); 
     288   newdim=(listdim *) calloc(1,sizeof(listdim)); 
    276289   newdim->dim=nom; 
    277290   newdim->suiv=NULL; 
    … …  
    310323   while(parcours_var) 
    311324   { 
    312       v=parcours_var->var; 
     325      v = parcours_var->var; 
    313326      strcpy(v->v_dimchar,(lin->dim).last); 
    314       Save_Length((lin->dim).last,5); 
    315327      parcours_var=parcours_var->suiv; 
    316328   } 
    … …  
    319331 
    320332/******************************************************************************/ 
    321 /*                                num_dims                                    */ 
     333/*                              get_num_dims                                  */ 
    322334/******************************************************************************/ 
    323335/* This subroutine is used to know the dimension of a table                   */ 
    324336/******************************************************************************/ 
    325337/*                                                                            */ 
    326 /*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */ 
    327 /*                                                                            */ 
    328 /******************************************************************************/ 
    329 int num_dims(listdim *d) 
    330 { 
    331    listdim *parcours; 
    332    int compteur = 0; 
    333  
    334    parcours = d; 
    335    while(parcours) 
    336    { 
    337      compteur++; 
    338      parcours=parcours->suiv; 
    339    } 
    340    return compteur; 
     338/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */ 
     339/*                                                                            */ 
     340/******************************************************************************/ 
     341int get_num_dims ( const listdim *d ) 
     342{ 
     343    listdim *parcours; 
     344    int compteur = 0; 
     345 
     346    parcours = (listdim *) d; 
     347    while(parcours) 
     348    { 
     349        compteur++; 
     350        parcours = parcours->suiv; 
     351    } 
     352    return compteur; 
    341353} 
    342354 
    … …  
    348360/*      struct : variable                                                     */ 
    349361/******************************************************************************/ 
    350 variable * createvar(char *nom,listdim *d) 
    351 { 
    352   variable *var; 
    353   listdim *dims; 
    354   char ligne[LONG_C]; 
    355   char listdimension[LONG_C]; 
    356  
    357    var=(variable *) malloc(sizeof(variable)); 
    358    /*                                                                         */ 
    359    Init_Variable(var); 
    360    /*                                                                         */ 
    361    strcpy(var->v_nomvar,nom); 
    362    Save_Length(nom,4); 
    363    /*                                                                         */ 
    364    strcpy(listdimension,""); 
    365    strcpy(var->v_modulename,curmodulename); 
    366    Save_Length(curmodulename,6); 
    367    strcpy(var->v_commoninfile,mainfile); 
    368    Save_Length(mainfile,10); 
    369    strcpy(var->v_subroutinename,subroutinename); 
    370    Save_Length(subroutinename,11); 
    371    /*                                                                         */ 
    372    if ( strcasecmp(nameinttypename,"") ) 
    373    { 
    374       strcpy(var->v_nameinttypename,nameinttypename); 
    375       Save_Length(nameinttypename,9); 
    376    } 
    377           
    378    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1; 
    379    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1; 
    380    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ; 
    381    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ; 
    382    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1; 
    383    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1; 
    384    /*                                                                         */ 
    385    var->v_dimension=d; 
     362variable * createvar(const char *nom, listdim *d) 
     363{ 
     364    variable *var; 
     365    listdim *dims; 
     366    char ligne[LONG_M]; 
     367    char listdimension[LONG_M]; 
     368 
     369    var = (variable *) calloc(1,sizeof(variable)); 
     370 
     371    Init_Variable(var); 
     372 
     373    strcpy(listdimension,""); 
     374    strcpy(var->v_nomvar,nom); 
     375    strcpy(var->v_modulename,curmodulename); 
     376    strcpy(var->v_commoninfile,cur_filename); 
     377    strcpy(var->v_subroutinename,subroutinename); 
     378 
     379    if ( strcasecmp(nameinttypename,"") ) 
     380    { 
     381        strcpy(var->v_nameinttypename,nameinttypename); 
     382    } 
     383 
     384    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1; 
     385    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1; 
     386    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ; 
     387    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ; 
     388    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1; 
     389    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1; 
     390 
     391   var->v_dimension = d; 
    386392 
    387393   /* Creation of the string for the dimension of this variable               */ 
    388    dimsempty = 1; 
    389    if ( d ) 
    390    { 
    391       var->v_dimensiongiven=1; 
    392       dims = d; 
    393       while (dims) 
    394       { 
    395          if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) 
    396                                                                   dimsempty = 0; 
    397          sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
    398          strcat(listdimension,ligne); 
    399          if ( dims->suiv ) 
    400          { 
    401             strcat(listdimension,","); 
    402          } 
    403          dims = dims->suiv; 
    404       } 
    405 /*RB*/ 
    406       if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty=1; 
    407 /*RBend*/ 
    408    } 
    409    strcpy(var->v_readedlistdimension,listdimension); 
    410    Save_Length(listdimension,15); 
    411    /*                                                                         */ 
    412    var->v_nbdim=num_dims(d); 
    413    /*                                                                         */ 
    414    return var; 
     394    dimsempty = 1; 
     395    if ( d ) 
     396    { 
     397        var->v_dimensiongiven = 1; 
     398        dims = d; 
     399        while (dims) 
     400        { 
     401            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) 
     402            { 
     403                dimsempty = 0; 
     404            } 
     405            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
     406            strcat(listdimension,ligne); 
     407            if ( dims->suiv ) 
     408            { 
     409                strcat(listdimension,","); 
     410            } 
     411            dims = dims->suiv; 
     412        } 
     413        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1; 
     414    } 
     415    strcpy(var->v_readedlistdimension,listdimension); 
     416    Save_Length(listdimension,15); 
     417    var->v_nbdim = get_num_dims(d); 
     418 
     419    return var; 
    415420} 
    416421 
    … …  
    433438   listvar *tmpvar ; 
    434439 
    435    newvar=(listvar *) malloc (sizeof (listvar)); 
     440   newvar=(listvar *) calloc(1,sizeof(listvar)); 
    436441   newvar->var=v; 
    437442   newvar->suiv = NULL; 
    … …  
    466471/*                                                                            */ 
    467472/******************************************************************************/ 
    468 listvar *settype(char *nom,listvar *lin) 
     473listvar *settype(const char *nom, listvar *lin) 
    469474{ 
    470475   listvar *newvar; 
    471476   variable *v; 
    472477 
    473    newvar=lin; 
     478   newvar = lin; 
    474479   while (newvar) 
    475480   { 
    476       v=newvar->var; 
     481      v = newvar->var; 
    477482      strcpy(v->v_typevar,nom); 
    478       Save_Length(nom,3); 
    479       newvar=newvar->suiv; 
    480    } 
    481    newvar=lin; 
     483      v->v_catvar = get_cat_var(v); 
     484      newvar = newvar->suiv; 
     485   } 
     486   newvar = lin; 
    482487   return newvar ; 
    483488} 
    … …  
    511516   variable *v; 
    512517   int out ; 
    513     
     518 
    514519   newvar=lin; 
    515520   out = 0; 
    … …  
    531536   listname *tmpvar; 
    532537 
    533    newvar=(listname *) malloc (sizeof (listname)); 
     538   newvar=(listname *) calloc(1,sizeof(listname)); 
    534539   strcpy(newvar->n_name,nom); 
    535540   newvar->suiv = NULL; 
    … …  
    549554      } 
    550555      tmpvar -> suiv = newvar; 
    551    } 
     556      } 
    552557      else 
    553558      { 
    … …  
    568573    tmpvar = tmpvar->suiv; 
    569574   } 
    570     
     575 
    571576   tmpvar->suiv = l2; 
    572     
     577 
    573578   return l1; 
    574579} 
    575580 
    576 void *createstringfromlistname(char *ligne, listname *lin) 
    577 { 
    578 listname *tmpvar; 
    579  
    580 strcpy(ligne,""); 
    581 tmpvar = lin; 
    582 while(tmpvar) 
    583 { 
    584   strcat(ligne,tmpvar->n_name); 
    585   if (tmpvar->suiv) strcat(ligne,","); 
    586   tmpvar=tmpvar->suiv; 
    587 } 
     581void createstringfromlistname(char *ligne, listname *lin) 
     582{ 
     583    listname *tmpvar; 
     584 
     585    strcpy(ligne,""); 
     586    tmpvar = lin; 
     587 
     588    while(tmpvar) 
     589    { 
     590        strcat(ligne,tmpvar->n_name); 
     591        if (tmpvar->suiv) strcat(ligne,","); 
     592        tmpvar=tmpvar->suiv; 
     593    } 
    588594} 
    589595 
    … …  
    607613void removeglobfromlist(listname **lin) 
    608614{ 
    609   listname *listemp; 
    610615  listname *parcours1; 
    611616  listvar *parcours2; 
    612617  listname * parcourspres; 
    613618  int out; 
    614    
     619 
    615620  parcours1 = *lin; 
    616621  parcourspres = (listname *)NULL; 
    617    
     622 
    618623  while (parcours1) 
    619624  { 
    … …  
    644649   { 
    645650   parcourspres = parcours1; 
    646     parcours1 = parcours1->suiv;   
     651    parcours1 = parcours1->suiv; 
    647652    } 
    648653  } 
    … …  
    651656void writelistpublic(listname *lin) 
    652657{ 
    653   listname *parcours1; 
    654   char ligne[LONG_40M]; 
    655   char tempname[LONG_4M]; 
    656    
    657   if (lin) 
    658   { 
    659   sprintf(ligne,"public :: "); 
    660   parcours1 = lin; 
    661    
    662   while (parcours1) 
    663   { 
    664     strcat(ligne,parcours1->n_name); 
    665     if (parcours1->suiv) strcat(ligne,", "); 
    666     parcours1 = parcours1->suiv;   
    667   } 
    668   tofich(fortranout,ligne,1); 
    669   } 
    670  
     658    listname *parcours1; 
     659    char ligne[LONG_M]; 
     660 
     661    if (lin) 
     662    { 
     663        sprintf(ligne,"public :: "); 
     664        parcours1 = lin; 
     665 
     666        while ( parcours1 ) 
     667        { 
     668            strcat(ligne, parcours1->n_name); 
     669            if ( parcours1->suiv ) strcat(ligne,", "); 
     670            parcours1 = parcours1->suiv; 
     671        } 
     672        tofich(fortran_out,ligne,1); 
     673    } 
    671674} 
    672675 
    673676void Init_List_Data_Var() 
    674677{ 
    675 listvar *parcours; 
    676  
    677 parcours = List_Data_Var_Cur; 
    678  
    679 if (List_Data_Var_Cur) 
    680 { 
    681 while (parcours) 
    682 { 
    683  List_Data_Var_Cur = List_Data_Var_Cur->suiv; 
    684  free(parcours); 
    685  parcours = List_Data_Var_Cur; 
    686 } 
    687 } 
    688  
    689 List_Data_Var_Cur = NULL; 
    690  
    691 } 
     678    listvar *parcours; 
     679 
     680    parcours = List_Data_Var_Cur; 
     681 
     682    if (List_Data_Var_Cur) 
     683    { 
     684        while (parcours) 
     685        { 
     686            List_Data_Var_Cur = List_Data_Var_Cur->suiv; 
     687            free(parcours); 
     688            parcours = List_Data_Var_Cur; 
     689        } 
     690    } 
     691    List_Data_Var_Cur = NULL; 
     692} 
     693 
     694int get_cat_var(variable *var) 
     695{ 
     696    if (!strcasecmp(var->v_typevar, "CHARACTER")) 
     697        return 1; 
     698    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL"))) 
     699        return 2; 
     700    else if (!strcasecmp(var->v_typevar, "LOGICAL")) 
     701        return 3; 
     702    else if (!strcasecmp(var->v_typevar, "INTEGER")) 
     703        return 4; 
     704    else 
     705        return 0; 
     706} 
Note: See TracChangeset for help on using the changeset viewer.