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 4777 for vendors – NEMO

Changeset 4777 for vendors


Ignore:
Timestamp:
2014-09-19T15:51:42+02:00 (10 years ago)
Author:
rblod
Message:

Load working_directory into vendors/AGRIF/current.

Location:
vendors/AGRIF/current
Files:
21 added
30 deleted
31 edited

Legend:

Unmodified
Added
Removed

  • vendors/AGRIF/current/LIB/DiversListe.c

    r2671 r4777  
    4848void Add_Common_var_1() 
    4949{ 
    50    listvar *newvar; 
    51    listvar *newvar2; 
    52    variable *newvariable; 
    53    listdim *dims; 
    54    char listdimension[LONG_C]; 
    55    char ligne[LONG_C]; 
    56    int out; 
    57  
    58    if ( firstpass == 1 ) 
    59    { 
    60  
    61    newvar = (listvar *)malloc(sizeof(listvar)); 
    62    newvariable = (variable *)malloc(sizeof(variable)); 
    63    /*                                                                         */ 
    64    Init_Variable(newvariable); 
    65    /*                                                                         */ 
    66    strcpy(newvariable->v_nomvar,commonvar); 
    67    Save_Length(commonvar,4); 
    68    strcpy(newvariable->v_commonname,commonblockname); 
    69    Save_Length(commonblockname,7); 
    70    strcpy(newvariable->v_modulename,curmodulename); 
    71    Save_Length(curmodulename,6); 
    72    strcpy(newvariable->v_subroutinename,subroutinename); 
    73    Save_Length(subroutinename,11); 
    74    newvariable->v_positioninblock= positioninblock; 
    75    newvariable->v_common=1; 
    76    strcpy(newvariable->v_commoninfile,mainfile); 
    77    Save_Length(mainfile,10); 
    78  
    79    newvar->var = newvariable; 
    80  
    81    if ( commondim ) 
    82    { 
    83       newvariable->v_dimension=commondim; 
    84       newvariable->v_dimensiongiven=1; 
    85       newvariable->v_nbdim=num_dims(commondim); 
    86       /* Creation of the string for the dimension of this variable            */ 
    87       dimsempty = 1; 
    88       strcpy(listdimension,""); 
    89  
    90       if ( commondim ) 
    91       { 
    92          dims = commondim; 
    93          while (dims) 
    94          { 
    95             if ( strcasecmp(dims->dim.first,"") || 
    96                  strcasecmp(dims->dim.last,""))  dimsempty = 0; 
    97             sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
    98             strcat(listdimension,ligne); 
    99             if ( dims->suiv ) strcat(listdimension,","); 
    100             dims = dims->suiv; 
    101          } 
    102          if ( dimsempty == 1 ) newvariable->v_dimsempty=1; 
    103       } 
    104       strcpy(newvariable->v_readedlistdimension,listdimension); 
    105       Save_Length(listdimension,15); 
    106    } 
    107  
    108  
    109    newvar->suiv = NULL; 
    110  
    111    if ( !List_Common_Var ) 
    112    { 
    113       List_Common_Var = newvar; 
    114    } 
    115    else 
    116    { 
    117       newvar2 = List_Common_Var; 
    118       out = 0 ; 
    119       while ( newvar2 && out == 0 ) 
    120       { 
    121          if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) && 
    122               !strcasecmp(newvar2->var->v_commonname,commonblockname) && 
    123               !strcasecmp(newvar2->var->v_subroutinename,subroutinename) 
    124                           ) out = 1 ; 
    125          else newvar2 = newvar2->suiv; 
    126       } 
    127       if ( out == 0 ) 
    128       { 
    129          newvar->suiv = List_Common_Var; 
    130          List_Common_Var = newvar; 
    131       } 
    132       else 
    133       { 
    134          free(newvar); 
    135       } 
    136    } 
    137    } 
     50    listvar *newvar; 
     51    listvar *newvar2; 
     52    variable *newvariable; 
     53    listdim *dims; 
     54    char listdimension[LONG_M]; 
     55    char ligne[LONG_M]; 
     56    int out; 
     57 
     58    if ( firstpass == 1 ) 
     59    { 
     60        newvar = (listvar *) calloc(1,sizeof(listvar)); 
     61        newvariable = (variable *) calloc(1,sizeof(variable)); 
     62 
     63        Init_Variable(newvariable); 
     64 
     65        strcpy(newvariable->v_nomvar,commonvar); 
     66        strcpy(newvariable->v_commonname,commonblockname); 
     67        strcpy(newvariable->v_modulename,curmodulename); 
     68        strcpy(newvariable->v_subroutinename,subroutinename); 
     69        strcpy(newvariable->v_commoninfile,cur_filename); 
     70        newvariable->v_positioninblock = positioninblock; 
     71        newvariable->v_common = 1; 
     72        newvar->var = newvariable; 
     73 
     74        if ( commondim ) 
     75        { 
     76            newvariable->v_dimension = commondim; 
     77            newvariable->v_dimensiongiven = 1; 
     78            newvariable->v_nbdim = get_num_dims(commondim); 
     79 
     80            /* Creation of the string for the dimension of this variable            */ 
     81            dimsempty = 1; 
     82            strcpy(listdimension,""); 
     83 
     84            dims = commondim; 
     85            while (dims) 
     86            { 
     87                if ( strcasecmp(dims->dim.first,"") || 
     88                     strcasecmp(dims->dim.last,""))  dimsempty = 0; 
     89                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
     90                strcat(listdimension,ligne); 
     91                if ( dims->suiv ) strcat(listdimension,","); 
     92                dims = dims->suiv; 
     93            } 
     94            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1; 
     95 
     96            strcpy(newvariable->v_readedlistdimension,listdimension); 
     97            Save_Length(listdimension,15); 
     98        } 
     99 
     100        newvar->suiv = NULL; 
     101 
     102        if ( !List_Common_Var ) 
     103        { 
     104            List_Common_Var = newvar; 
     105        } 
     106        else 
     107        { 
     108            newvar2 = List_Common_Var; 
     109            out = 0 ; 
     110            while ( newvar2 && out == 0 ) 
     111            { 
     112                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) && 
     113                     !strcasecmp(newvar2->var->v_commonname,commonblockname) && 
     114                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename) 
     115                   ) out = 1 ; 
     116                else newvar2 = newvar2->suiv; 
     117            } 
     118            if ( out == 0 ) 
     119            { 
     120                newvar->suiv = List_Common_Var; 
     121                List_Common_Var = newvar; 
     122            } 
     123            else 
     124            { 
     125                free(newvar); 
     126            } 
     127        } 
     128    } 
    138129} 
    139130 
    … …  
    145136/*                                                                            */ 
    146137/******************************************************************************/ 
    147 listnom *Addtolistnom(char *nom, listnom *listin,int value) 
    148 { 
    149    listnom *newnom; 
    150    listnom *parcours; 
    151    int out; 
    152  
    153    newnom=(listnom *) malloc (sizeof (listnom)); 
    154    strcpy(newnom->o_nom,nom); 
    155    Save_Length(nom,23); 
    156    newnom->o_val = value; 
    157    newnom->suiv = NULL; 
    158  
    159    if ( !listin ) listin = newnom; 
    160    else 
    161    { 
    162       parcours = listin; 
    163       out = 0 ; 
    164       while ( parcours && out == 0 ) 
    165       { 
    166          if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ; 
    167          else parcours=parcours->suiv; 
    168       } 
    169       if ( out == 0 ) 
    170       { 
    171           newnom->suiv = listin; 
    172           listin = newnom; 
    173       } 
    174       else 
    175       { 
    176          free(newnom); 
    177       } 
    178    } 
    179    return listin; 
     138listnom *Addtolistnom(const char *nom, listnom *listin, int value) 
     139{ 
     140    listnom *newnom; 
     141    listnom *parcours; 
     142    int out; 
     143 
     144    newnom = (listnom*) calloc(1, sizeof(listnom)); 
     145    strcpy(newnom->o_nom, nom); 
     146    newnom->o_val = value; 
     147    newnom->suiv = NULL; 
     148 
     149    if ( listin == NULL ) 
     150    { 
     151        listin = newnom; 
     152    } 
     153    else 
     154    { 
     155        parcours = listin; 
     156        out = 0 ; 
     157        while ( parcours && out == 0 ) 
     158        { 
     159            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ; 
     160            else parcours = parcours->suiv; 
     161        } 
     162        if ( out == 0 ) 
     163        { 
     164            newnom->suiv = listin; 
     165            listin = newnom; 
     166        } 
     167        else 
     168        { 
     169            free(newnom); 
     170        } 
     171    } 
     172    return listin; 
    180173} 
    181174 
    … …  
    193186/*                                                                            */ 
    194187/******************************************************************************/ 
    195 listname *Addtolistname(char *nom,listname *input) 
    196 { 
    197    listname *newnom; 
    198    listname *parcours; 
    199    int out; 
    200  
    201    if ( !input ) 
    202    { 
    203       newnom=(listname *) malloc (sizeof (listname)); 
    204       strcpy(newnom->n_name,nom); 
    205       Save_Length(nom,20); 
    206       newnom->suiv = NULL; 
    207       input = newnom; 
    208    } 
    209    else 
    210    { 
    211       parcours = input; 
    212       out = 0 ; 
    213       while ( parcours && out == 0 ) 
    214       { 
    215          if ( !strcasecmp(parcours->n_name,nom) ) out = 1; 
    216          else parcours=parcours->suiv; 
    217       } 
    218       if ( out == 0 ) 
    219       { 
    220          newnom=(listname *) malloc (sizeof (listname)); 
    221          strcpy(newnom->n_name,nom); 
    222          Save_Length(nom,20); 
    223          newnom->suiv = input; 
    224          input = newnom; 
    225       } 
    226    } 
    227    return input; 
     188listname *Addtolistname(const char *nom, listname *input) 
     189{ 
     190    listname *newnom; 
     191    listname *parcours; 
     192    int out; 
     193 
     194    if ( !input ) 
     195    { 
     196        newnom = (listname*) calloc(1, sizeof(listname)); 
     197        strcpy(newnom->n_name, nom); 
     198        newnom->suiv = NULL; 
     199        input = newnom; 
     200    } 
     201    else 
     202    { 
     203        parcours = input; 
     204        out = 0 ; 
     205        while ( parcours && out == 0 ) 
     206        { 
     207            if ( !strcasecmp(parcours->n_name,nom) ) out = 1; 
     208            else parcours=parcours->suiv; 
     209        } 
     210        if ( out == 0 ) 
     211        { 
     212            newnom = (listname*) calloc(1,sizeof(listname)); 
     213            strcpy(newnom->n_name, nom); 
     214            newnom->suiv = input; 
     215            input = newnom; 
     216        } 
     217    } 
     218    return input; 
    228219} 
    229220 
    … …  
    236227/*                                                                            */ 
    237228/******************************************************************************/ 
    238 int ModuleIsDefineInInputFile(char *name) 
    239 { 
    240    listnom *newnom; 
    241    int out; 
    242  
    243    out = 0; 
    244    if ( listofmodules ) 
    245    { 
    246       newnom = listofmodules; 
    247       while( newnom && out == 0 ) 
    248       { 
    249          if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ; 
    250          else newnom=newnom->suiv; 
    251       } 
    252    } 
    253    return out; 
     229int ModuleIsDefineInInputFile(const char *name) 
     230{ 
     231    listnom *newnom; 
     232    int out; 
     233 
     234    out = 0; 
     235    if ( listofmodules ) 
     236    { 
     237        newnom = listofmodules; 
     238        while( newnom && out == 0 ) 
     239        { 
     240            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ; 
     241            else newnom = newnom->suiv; 
     242        } 
     243    } 
     244    return out; 
    254245} 
    255246 
    … …  
    270261/*                                                                            */ 
    271262/******************************************************************************/ 
    272 void Addmoduletothelisttmp(char *name) 
    273 { 
    274   listusemodule *newmodule; 
    275   listusemodule *parcours; 
    276   int out; 
    277  
    278   if ( !listofmoduletmp) 
    279   { 
    280     newmodule =(listusemodule *)malloc(sizeof(listusemodule)); 
    281     strcpy(newmodule->u_usemodule,name); 
    282     Save_Length(name,16); 
    283     strcpy(newmodule->u_cursubroutine,subroutinename); 
    284     Save_Length(subroutinename,18); 
    285     newmodule->suiv = NULL; 
    286     listofmoduletmp = newmodule ; 
    287   } 
    288   else 
    289   { 
    290     parcours = listofmoduletmp; 
    291     out = 0; 
    292     while( parcours && out == 0 ) 
    293     { 
    294        if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1; 
    295        else parcours = parcours->suiv; 
    296     } 
    297     if ( out == 0 ) 
    298     { 
    299        newmodule =(listusemodule *)malloc(sizeof(listusemodule)); 
    300        strcpy(newmodule->u_usemodule,name); 
    301        Save_Length(name,16); 
    302        strcpy(newmodule->u_cursubroutine,subroutinename); 
    303        Save_Length(subroutinename,18); 
    304        newmodule->suiv = listofmoduletmp; 
    305        listofmoduletmp = newmodule; 
    306     } 
    307   } 
     263void Addmoduletothelisttmp(const char *name) 
     264{ 
     265    listusemodule *newmodule; 
     266    listusemodule *parcours; 
     267    int out; 
     268 
     269    if ( !listofmoduletmp ) 
     270    { 
     271        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule)); 
     272        strcpy(newmodule->u_usemodule, name); 
     273        strcpy(newmodule->u_cursubroutine, subroutinename); 
     274        newmodule->suiv = NULL; 
     275        listofmoduletmp = newmodule ; 
     276    } 
     277    else 
     278    { 
     279        parcours = listofmoduletmp; 
     280        out = 0; 
     281        while( parcours && out == 0 ) 
     282        { 
     283            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1; 
     284            else parcours = parcours->suiv; 
     285        } 
     286        if ( out == 0 ) 
     287        { 
     288            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule)); 
     289            strcpy(newmodule->u_usemodule, name); 
     290            strcpy(newmodule->u_cursubroutine, subroutinename); 
     291            newmodule->suiv = listofmoduletmp; 
     292            listofmoduletmp = newmodule; 
     293        } 
     294    } 
    308295} 
    309296 
    … …  
    321308/*                                                                            */ 
    322309/******************************************************************************/ 
    323 void Add_NameOfModule_1(char *nom) 
    324 { 
    325    listnom *newnom; 
    326  
    327    if ( firstpass == 1 ) 
    328    { 
    329       newnom=(listnom *) malloc (sizeof (listnom)); 
    330       strcpy(newnom->o_nom,nom); 
    331       Save_Length(nom,23); 
    332       newnom->suiv = List_NameOfModule; 
    333       List_NameOfModule = newnom; 
    334    } 
     310void Add_NameOfModule_1(const char *nom) 
     311{ 
     312    listnom *newnom; 
     313 
     314    if ( firstpass == 1 ) 
     315    { 
     316        newnom = (listnom *) calloc(1,sizeof(listnom)); 
     317        strcpy(newnom->o_nom,nom); 
     318        newnom->suiv = List_NameOfModule; 
     319        List_NameOfModule = newnom; 
     320    } 
    335321} 
    336322 
    … …  
    348334/*                                                                            */ 
    349335/******************************************************************************/ 
    350 void Add_NameOfCommon_1(char *nom,char *cursubroutinename) 
    351 { 
    352    listnom *newnom; 
    353    listnom *parcours; 
    354  
    355    if ( firstpass == 1 ) 
    356    { 
    357       parcours = List_NameOfCommon; 
    358       while ( parcours && strcasecmp(parcours->o_nom,nom) ) 
    359                                                       parcours = parcours->suiv; 
    360       if ( !parcours ) 
    361       { 
    362          newnom=(listnom *) malloc (sizeof (listnom)); 
    363          strcpy(newnom->o_nom,nom); 
    364          strcpy(newnom->o_subroutinename,cursubroutinename); 
    365          Save_Length(nom,23); 
    366          newnom->suiv = List_NameOfCommon; 
    367          List_NameOfCommon = newnom; 
    368       } 
    369    } 
     336void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename) 
     337{ 
     338    listnom *newnom; 
     339    listnom *parcours; 
     340 
     341    if ( firstpass == 1 ) 
     342    { 
     343        parcours = List_NameOfCommon; 
     344        while ( parcours && strcasecmp(parcours->o_nom,nom) ) 
     345            parcours = parcours->suiv; 
     346        if ( !parcours ) 
     347        { 
     348            newnom = (listnom *) calloc(1,sizeof(listnom)); 
     349            strcpy(newnom->o_nom,nom); 
     350            strcpy(newnom->o_subroutinename,cursubroutinename); 
     351            newnom->suiv = List_NameOfCommon; 
     352            List_NameOfCommon = newnom; 
     353        } 
     354    } 
    370355} 
    371356 
    … …  
    378363/*                                                                            */ 
    379364/******************************************************************************/ 
    380 void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple) 
    381 { 
    382    listvarpointtovar *pointtmp; 
    383  
    384    if ( firstpass == 1 ) 
    385    { 
    386       /* we should complete the List_CouplePointed_Var                        */ 
    387       pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar)); 
    388       strcpy(pointtmp->t_usemodule,namemodule); 
    389       Save_Length(namemodule,28); 
    390       strcpy(pointtmp->t_cursubroutine,subroutinename); 
    391       Save_Length(subroutinename,29); 
    392       pointtmp->t_couple = couple; 
    393       if ( List_CouplePointed_Var ) 
    394       { 
    395          pointtmp->suiv = List_CouplePointed_Var; 
    396          List_CouplePointed_Var = pointtmp; 
    397       } 
    398       else 
    399       { 
    400          pointtmp->suiv = NULL; 
    401          List_CouplePointed_Var = pointtmp; 
    402       } 
    403    } 
     365void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple) 
     366{ 
     367    listvarpointtovar *pointtmp; 
     368 
     369    /* we should complete the List_CouplePointed_Var                        */ 
     370    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar)); 
     371    strcpy(pointtmp->t_usemodule, namemodule); 
     372    strcpy(pointtmp->t_cursubroutine, subroutinename); 
     373    pointtmp->t_couple = couple; 
     374    if ( List_CouplePointed_Var ) 
     375    { 
     376        pointtmp->suiv = List_CouplePointed_Var; 
     377    } 
     378    else 
     379    { 
     380        pointtmp->suiv = NULL; 
     381    } 
     382    List_CouplePointed_Var = pointtmp; 
    404383} 
    405384 
    … …  
    420399/*                                                                            */ 
    421400/******************************************************************************/ 
    422 void Add_Include_1(char *name) 
     401void Add_Include_1(const char *name) 
     402{ 
     403    listusemodule *newinclude; 
     404 
     405    if ( firstpass == 1 ) 
     406    { 
     407        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule)); 
     408        strcpy(newinclude->u_usemodule,name); 
     409        strcpy(newinclude->u_cursubroutine,subroutinename); 
     410 
     411        newinclude->suiv = List_Include; 
     412        List_Include  = newinclude ; 
     413    } 
     414} 
     415 
     416/******************************************************************************/ 
     417/*                     Add_ImplicitNoneSubroutine_1                           */ 
     418/******************************************************************************/ 
     419/* This subroutine is used to add a record to a list of struct                */ 
     420/******************************************************************************/ 
     421/*                                                                            */ 
     422/*                                                                            */ 
     423/******************************************************************************/ 
     424void Add_ImplicitNoneSubroutine_1() 
     425{ 
     426    if ( firstpass == 1 ) 
     427        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine); 
     428} 
     429 
     430/******************************************************************************/ 
     431/*                        WriteIncludeDeclaration                             */ 
     432/******************************************************************************/ 
     433/* Firstpass 0                                                                */ 
     434/******************************************************************************/ 
     435/*                                                                            */ 
     436/******************************************************************************/ 
     437void WriteIncludeDeclaration(FILE* tofile) 
    423438{ 
    424439  listusemodule *newinclude; 
    425440 
    426   if ( firstpass == 1 ) 
    427   { 
    428   newinclude =(listusemodule *)malloc(sizeof(listusemodule)); 
    429   strcpy(newinclude->u_usemodule,name); 
    430   Save_Length(name,16); 
    431   strcpy(newinclude->u_cursubroutine,subroutinename); 
    432   Save_Length(subroutinename,18); 
    433   newinclude->suiv = NULL; 
    434  
    435   if ( !List_Include) 
    436   { 
    437      List_Include  = newinclude ; 
    438   } 
    439   else 
    440   { 
    441     newinclude->suiv = List_Include; 
    442     List_Include = newinclude; 
    443   } 
    444   } 
    445 } 
    446  
    447 /******************************************************************************/ 
    448 /*                     Add_ImplicitNoneSubroutine_1                           */ 
    449 /******************************************************************************/ 
    450 /* This subroutine is used to add a record to a list of struct                */ 
    451 /******************************************************************************/ 
    452 /*                                                                            */ 
    453 /*                                                                            */ 
    454 /******************************************************************************/ 
    455 void Add_ImplicitNoneSubroutine_1() 
    456 { 
    457  
    458   if ( firstpass == 1 ) 
    459   { 
    460      List_ImplicitNoneSubroutine = Addtolistname(subroutinename, 
    461                                                    List_ImplicitNoneSubroutine); 
    462   } 
    463 } 
    464  
    465  
    466 /******************************************************************************/ 
    467 /*                        WriteIncludeDeclaration                             */ 
    468 /******************************************************************************/ 
    469 /* Firstpass 0                                                                */ 
    470 /******************************************************************************/ 
    471 /*                                                                            */ 
    472 /******************************************************************************/ 
    473 void WriteIncludeDeclaration() 
    474 { 
    475   listusemodule *newinclude; 
    476  
    477441  newinclude = List_Include; 
    478   fprintf(fortranout,"\n"); 
     442  fprintf(tofile,"\n"); 
    479443  while ( newinclude ) 
    480444  { 
    481445     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) ) 
    482446     { 
    483         fprintf(fortranout,"      INCLUDE %s \n",newinclude->u_usemodule); 
     447        fprintf(tofile, "      include %s\n",newinclude->u_usemodule); 
    484448     } 
    485449     newinclude = newinclude ->suiv; 
    … …  
    498462/*                                                                            */ 
    499463/******************************************************************************/ 
    500 void Add_Save_Var_1 (char *name,listdim *d) 
    501 { 
    502   listvar *newvar; 
    503   listdim *dims; 
    504   char ligne[LONG_C]; 
    505   char listdimension[LONG_C]; 
    506  
    507   if ( firstpass == 1 ) 
    508   { 
    509      newvar=(listvar *)malloc(sizeof(listvar)); 
    510      newvar->var=(variable *)malloc(sizeof(variable)); 
    511      /*                                                                       */ 
    512      Init_Variable(newvar->var); 
    513      /*                                                                       */ 
    514      newvar->var->v_save=1; 
    515      strcpy(newvar->var->v_nomvar,name); 
    516      Save_Length(name,4); 
    517      strcpy(newvar->var->v_modulename,curmodulename); 
    518      Save_Length(curmodulename,6); 
    519      strcpy(newvar->var->v_subroutinename,subroutinename); 
    520      Save_Length(subroutinename,11); 
    521      strcpy(newvar->var->v_commoninfile,mainfile); 
    522      Save_Length(mainfile,10); 
    523  
    524      newvar->var->v_dimension=d; 
    525      /* Creation of the string for the dimension of this variable             */ 
    526      dimsempty = 1; 
    527  
    528      if ( d ) 
    529      { 
    530         newvar->var->v_dimensiongiven=1; 
    531         dims = d; 
    532         while (dims) 
    533         { 
    534            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) 
    535                                                                   dimsempty = 0; 
    536            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
    537            strcat(listdimension,ligne); 
    538            if ( dims->suiv ) 
    539            { 
    540               strcat(listdimension,","); 
    541            } 
    542            dims = dims->suiv; 
    543         } 
    544         if ( dimsempty == 1 ) newvar->var->v_dimsempty=1; 
    545      } 
    546  
    547 /*     strcpy(newvar->var->v_readedlistdimension,listdimension); 
    548      Save_Length(listdimension,15);*/ 
    549      /*                                                                       */ 
    550      newvar->suiv = NULL; 
    551  
    552      if ( !List_Save_Var ) 
    553      { 
    554         List_Save_Var  = newvar ; 
    555      } 
    556      else 
    557      { 
     464void Add_Save_Var_1 (const char *name, listdim *d) 
     465{ 
     466    listvar *newvar; 
     467    listdim *dims; 
     468    char ligne[LONG_M]; 
     469    char listdimension[LONG_M]; 
     470 
     471    if ( firstpass == 1 ) 
     472    { 
     473        newvar = (listvar *) calloc(1,sizeof(listvar)); 
     474        newvar->var = (variable *) calloc(1,sizeof(variable)); 
     475 
     476        Init_Variable(newvar->var); 
     477 
     478        newvar->var->v_save = 1; 
     479        strcpy(newvar->var->v_nomvar,name); 
     480        strcpy(newvar->var->v_modulename,curmodulename); 
     481        strcpy(newvar->var->v_subroutinename,subroutinename); 
     482        strcpy(newvar->var->v_commoninfile,cur_filename); 
     483 
     484        newvar->var->v_dimension = d; 
     485 
     486        /* Creation of the string for the dimension of this variable             */ 
     487        dimsempty = 1; 
     488 
     489        if ( d ) 
     490        { 
     491            newvar->var->v_dimensiongiven = 1; 
     492            dims = d; 
     493            while (dims) 
     494            { 
     495                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) 
     496                    dimsempty = 0; 
     497                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
     498                strcat(listdimension,ligne); 
     499                if ( dims->suiv )   strcat(listdimension,","); 
     500                dims = dims->suiv; 
     501            } 
     502            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1; 
     503        } 
     504 
    558505        newvar->suiv = List_Save_Var; 
    559506        List_Save_Var = newvar; 
    560      } 
    561   } 
     507    } 
    562508} 
    563509 
    564510void Add_Save_Var_dcl_1 (listvar *var) 
    565511{ 
    566   listvar *newvar; 
    567   listvar *parcours; 
    568  
    569   if ( firstpass == 1 ) 
    570   { 
    571      parcours = var; 
    572      while ( parcours ) 
    573      { 
    574         newvar=(listvar *)malloc(sizeof(listvar)); 
    575         newvar->var=(variable *)malloc(sizeof(variable)); 
    576         /*                                                                    */ 
    577         Init_Variable(newvar->var); 
    578         /*                                                                    */ 
    579         newvar->var->v_save=1; 
    580         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar); 
    581         strcpy(newvar->var->v_modulename,curmodulename); 
    582         Save_Length(curmodulename,6); 
    583         strcpy(newvar->var->v_subroutinename,subroutinename); 
    584         Save_Length(subroutinename,11); 
    585         strcpy(newvar->var->v_commoninfile,mainfile); 
    586         Save_Length(mainfile,10); 
    587         /*                                                                    */ 
    588         strcpy(newvar->var->v_readedlistdimension, 
    589              parcours->var->v_readedlistdimension); 
    590         newvar->var->v_nbdim = parcours->var->v_nbdim; 
    591         newvar->var->v_dimension = parcours->var->v_dimension; 
    592         /*                                                                    */ 
    593         newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven; 
    594         /*                                                                    */ 
    595         newvar->suiv = NULL; 
    596  
    597         if ( !List_Save_Var ) List_Save_Var  = newvar ; 
    598         else 
    599         { 
    600            newvar->suiv = List_Save_Var; 
    601            List_Save_Var = newvar; 
    602         } 
    603         parcours = parcours->suiv; 
    604      } 
    605   } 
    606 } 
     512    listvar *newvar; 
     513    listvar *parcours; 
     514 
     515    if ( firstpass == 1 ) 
     516    { 
     517        parcours = var; 
     518        while ( parcours ) 
     519        { 
     520            newvar = (listvar *) calloc(1,sizeof(listvar)); 
     521            newvar->var = (variable *) calloc(1,sizeof(variable)); 
     522 
     523            Init_Variable(newvar->var); 
     524 
     525            newvar->var->v_save = 1; 
     526            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar); 
     527            strcpy(newvar->var->v_modulename,curmodulename); 
     528            strcpy(newvar->var->v_subroutinename,subroutinename); 
     529            strcpy(newvar->var->v_commoninfile,cur_filename); 
     530            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension); 
     531 
     532            newvar->var->v_nbdim = parcours->var->v_nbdim; 
     533            newvar->var->v_catvar = parcours->var->v_catvar; 
     534            newvar->var->v_dimension = parcours->var->v_dimension; 
     535            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven; 
     536            newvar->suiv = List_Save_Var; 
     537            List_Save_Var = newvar; 
     538 
     539            parcours = parcours->suiv; 
     540        } 
     541    } 
     542} 

  • vendors/AGRIF/current/LIB/Makefile

    r1901 r4777  
    1 #- option to debug 
    2 C_D = -g # -g -Wall 
    3 # Compilation: 
    4 CC    = cc -O 
    5 #- 
    61OBJS = main.o WriteInFile.o toamr.o fortran.o  \ 
    72       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \ 
    … …  
    149       WorkWithlistofcoupled.o 
    1510 
    16  
    1711.SUFFIXES: 
    1812.SUFFIXES: .c .o 
    1913 
    20 all : conv 
    21    @echo CONV is ok 
     14all: conv 
     15   @echo 
     16   @echo =================================================== 
     17   @echo   CONV is ok 
     18   @echo =================================================== 
     19   @echo 
    2220 
    23 conv :  $(OBJS) 
    24    @$(CC) $(OBJS) -o ../$@ 
     21main.c: convert.y convert.lex 
     22   @echo =================================================== 
     23   @echo   Rebuilding main.c ... 
     24   @echo =================================================== 
     25   $(MAKE) -f Makefile.lex main.c 
     26 
     27fortran.c: fortran.y fortran.lex 
     28   @echo =================================================== 
     29   @echo   Rebuilding fortran.c ... 
     30   @echo =================================================== 
     31   $(MAKE) -f Makefile.lex fortran.c 
     32 
     33conv: $(OBJS) 
     34   $(CC) $(CFLAGS) -g $(OBJS) -o ../$@ 
     35 
     36%.o: %.c 
     37   $(CC) $(CFLAGS) -g -c $< -o $@ 
    2538 
    2639main.o : main.c 
    … …  
    2841toamr.o : toamr.c decl.h 
    2942WriteInFile.o : WriteInFile.c decl.h 
    30 dependfile.o : dependfile.c decl.h   
    31 SubLoopCreation.o : SubLoopCreation.c decl.h  
    32 WorkWithglobliste.o : WorkWithglobliste.c decl.h    
    33 WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h    
    34 WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h   
    35 Writedeclarations.o : Writedeclarations.c decl.h    
    36 UtilFortran.o : UtilFortran.c decl.h    
    37 WorkWithParameterlist.o : WorkWithParameterlist.c decl.h  
    38 UtilNotGridDep.o : UtilNotGridDep.c decl.h    
    39 WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h  
    40 DiversListe.o : DiversListe.c decl.h    
    41 UtilAgrif.o : UtilAgrif.c decl.h  
     43dependfile.o : dependfile.c decl.h 
     44SubLoopCreation.o : SubLoopCreation.c decl.h 
     45WorkWithglobliste.o : WorkWithglobliste.c decl.h 
     46WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h 
     47WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h 
     48Writedeclarations.o : Writedeclarations.c decl.h 
     49UtilFortran.o : UtilFortran.c decl.h 
     50WorkWithParameterlist.o : WorkWithParameterlist.c decl.h 
     51UtilNotGridDep.o : UtilNotGridDep.c decl.h 
     52WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h 
     53DiversListe.o : DiversListe.c decl.h 
     54UtilAgrif.o : UtilAgrif.c decl.h 
    4255WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h 
    4356UtilCharacter.o : UtilCharacter.c decl.h 
    … …  
    4760WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h 
    4861WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h 
    49 clean :  
    50    /bin/rm -f *.o y.output 
     62 
     63clean: 
     64   $(MAKE) -f Makefile.lex clean 
     65   $(RM) *.o conv 
     66    
     67clean-all: clean 
     68   $(MAKE) -f Makefile.lex clean-all 

  • vendors/AGRIF/current/LIB/Makefile.lex

    r2671 r4777  
    1 # Compilation: 
    2 CC    = cc -O -g -Wall 
    3 LEX      = flex 
     1LEX      = flex -i 
     2YACC  = bison -t -v -g 
    43 
    5 # option de flex et pas de lex 
    6 LEXFLAGS=-i 
    7 YACC = byacc -t -v -g 
    8 YACC = bison -t -v -g 
     4all: main.c fortran.c 
    95 
     6main.c : convert.tab.c convert.yy.c 
     7   cat   convert.tab.c convert.yy.c > main.c 
     8   $(RM) convert.tab.c convert.yy.c 
    109 
    11 OBJS = main.o WriteInFile.o toamr.o fortran.o  \ 
    12        dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \ 
    13        WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \ 
    14        Writedeclarations.o WorkWithglobliste.o UtilFortran.o \ 
    15        UtilNotGridDep.o WorkWithlistdatavariable.o \ 
    16        DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \ 
    17        UtilCharacter.o UtilListe.o UtilFile.o \ 
    18        WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \ 
    19        WorkWithlistofcoupled.o 
     10fortran.c : fortran.tab.c fortran.yy.c 
     11   cat   fortran.tab.c fortran.yy.c > fortran.c 
     12   $(RM) fortran.tab.c fortran.yy.c 
    2013 
    21 .SUFFIXES: 
    22 .SUFFIXES: .c .o 
     14convert.tab.c : convert.y decl.h 
     15   $(YACC) -p convert_ convert.y 
    2316 
    24 all : conv 
     17fortran.tab.c : fortran.y decl.h 
     18   $(YACC) -p fortran_ fortran.y 
    2519 
    26 conv :  $(OBJS) 
    27    $(CC) $(OBJS)  $(LEXLIB) -o ../$@ 
     20convert.yy.c : convert.lex 
     21   $(LEX) -P convert_ -o convert.yy.c convert.lex 
    2822 
    29 main.o : main.c 
    30 main.c : convert.tab.c  convert.yy.c 
    31    rm -f main.c 
    32    cat convert.tab.c  convert.yy.c > main.c 
    33    rm -f convert.yy.c convert.tab.c 
    34 fortran.o : fortran.c 
    35 fortran.c : fortran.tab.c fortran.yy.c 
    36    rm -f fortran.c 
    37    cat fortran.tab.c  fortran.yy.c > fortran.c 
    38 #rm -f fortran.yy.c fortran.tab.c 
    39 convert.tab.c : convert.y decl.h 
    40    $(YACC) convert.y 
    41 #  mv -f y.tab.c convert.tab.c 
    42 fortran.tab.c : fortran.y decl.h 
    43    $(YACC) -p fortran fortran.y 
    44 #  mv -f y.tab.c fortran.tab.c 
    45 #  mv -f y.output fortran.output 
    46 #  mv -f y.dot fortran.dot 
    47 convert.yy.c : convert.lex 
    48    $(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex 
    4923fortran.yy.c : fortran.lex 
    50    $(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex 
    51     
    52 toamr.o : toamr.c decl.h 
    53 WriteInFile.o : WriteInFile.c decl.h 
    54 dependfile.o : dependfile.c decl.h 
    55 SubLoopCreation.o : SubLoopCreation.c decl.h 
    56 WorkWithglobliste.o : WorkWithglobliste.c decl.h 
    57 WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h 
    58 WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h 
    59 Writedeclarations.o : Writedeclarations.c decl.h 
    60 UtilFortran.o : UtilFortran.c decl.h 
    61 WorkWithParameterlist.o : WorkWithParameterlist.c decl.h 
    62 UtilNotGridDep.o : UtilNotGridDep.c decl.h 
    63 WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h 
    64 DiversListe.o : DiversListe.c decl.h 
    65 UtilAgrif.o : UtilAgrif.c decl.h 
    66 WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h 
    67 UtilCharacter.o : UtilCharacter.c decl.h 
    68 UtilListe.o : UtilListe.c decl.h 
    69 UtilFile.o : UtilFile.c decl.h 
    70 WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h 
    71 WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h 
    72 WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h 
    73 clean :  
    74    /bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \ 
    75    fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \ 
    76    y.output 
     24   $(LEX) -P fortran_ -o fortran.yy.c fortran.lex 
     25 
     26clean: 
     27   $(RM) convert.yy.c convert.tab.c convert.output convert.vcg convert.dot \ 
     28        fortran.yy.c fortran.tab.c fortran.output fortran.vcg fortran.dot 
     29 
     30clean-all: clean 
     31   $(RM) main.c fortran.c 

  • vendors/AGRIF/current/LIB/SubLoopCreation.c

    r2671 r4777  
    4545 
    4646/******************************************************************************/ 
    47 /*                             writeheadnewsub_0                              */ 
    48 /******************************************************************************/ 
    49 /* Firstpass 0                                                                */ 
     47/*                           WriteBeginof_SubLoop                             */ 
     48/******************************************************************************/ 
    5049/* We should write the head of the subroutine sub_loop_<subroutinename>       */ 
    5150/******************************************************************************/ 
    5251/*                                                                            */ 
    5352/******************************************************************************/ 
    54 void writeheadnewsub_0() 
    55 { 
    56    char ligne[LONG_C]; 
    57  
    58    if ( firstpass == 0 && IsTabvarsUseInArgument_0() == 1 ) 
    59    { 
    60       if ( todebug == 1 ) printf("Enter in writeheadnewsub_0\n"); 
     53void WriteBeginof_SubLoop() 
     54{ 
     55   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename); 
     56   if ( IsTabvarsUseInArgument_0() == 1 ) 
     57   { 
     58      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n"); 
    6159      /* we should add the use agrif_uti l if it is necessary                 */ 
    6260      WriteHeadofSubroutineLoop(); 
    6361      WriteUsemoduleDeclaration(subroutinename); 
    64       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    65                                                        "      IMPLICIT NONE\n"); 
    66       WriteIncludeDeclaration(); 
     62      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     63      WriteIncludeDeclaration(fortran_out); 
    6764      /*                                                                      */ 
    6865      /* We should write once the declaration of tables (extract              */ 
    6966      /*    from pointer) in the new subroutine                               */ 
    70       if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n"); 
    71  
    72       if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(); 
    73       if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n"); 
    74  
    75       sprintf(ligne,"\n#include \"ParamFile%s.h\" \n",subroutinename); 
    76       tofich(fortranout,ligne,1); 
    77  
    78       WriteArgumentDeclaration_Sort(); 
    79  
    80       if ( mark == 1 ) fprintf(fortranout,"!!! 222222222222222 \n"); 
    81       writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortranout); 
    82       if ( mark == 1 ) fprintf(fortranout,"!!! 333333333333333 \n"); 
    83       writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,paramout); 
    84       if ( mark == 1 ) fprintf(fortranout,"!!! 444444444444444 \n"); 
    85       /* now we should write the function declaration                         */ 
    86       /*    case if it is the                                                 */ 
    87       WriteFunctionDeclaration(1); 
    88       if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n"); 
    89  
    90 //      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1); 
    91    
    92       if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n"); 
    93       if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n"); 
    94    } 
    95    else if ( firstpass == 0 ) 
    96    { 
    97       AddUseAgrifUtil_0(fortranout); 
     67      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out); 
     68 
     69      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out); 
     70      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out); 
     71      WriteArgumentDeclaration_Sort(fortran_out); 
     72      WriteFunctionDeclaration(fortran_out, 1); 
     73   } 
     74   else 
     75   { 
     76      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n"); 
     77      AddUseAgrifUtil_0(fortran_out); 
    9878      WriteUsemoduleDeclaration(subroutinename); 
    99       WriteIncludeDeclaration(); 
    100       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    101                                                        "      IMPLICIT NONE\n"); 
    102       if ( mark == 1 ) fprintf(fortranout,"!!! aaaaaaaaaaaaaaa \n"); 
    103       WriteLocalParamDeclaration(); 
    104       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n"); 
    105       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 
    106       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");       
     79      WriteIncludeDeclaration(fortran_out); 
     80      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     81      WriteLocalParamDeclaration(fortran_out); 
    10782      WriteArgumentDeclaration_beforecall(); 
    108 /*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout); 
    109       writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortranout);*/ 
    110       if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n"); 
    111       if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n"); 
    112 //      WriteSubroutineDeclaration(1); 
    113       if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n"); 
    114    } 
    115 } 
    116  
     83      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1); 
     84/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out); 
     85      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/ 
     86   } 
     87   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n"); 
     88   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename); 
     89} 
    11790 
    11891/******************************************************************************/ 
    … …  
    129102/*                                                                            */ 
    130103/******************************************************************************/ 
    131 void WriteVariablelist_subloop(FILE *outputfile,char *ligne) 
     104void WriteVariablelist_subloop(char *ligne) 
    132105{ 
    133106   listvar *parcours; 
    134    int compteur; 
    135  
    136    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop\n"); 
     107 
     108   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n"); 
    137109   parcours = List_SubroutineArgument_Var; 
    138110   didvariableadded = 0; 
    139    compteur = 0 ; 
    140111 
    141112   while ( parcours ) 
    142113   { 
    143  
    144114      /* if the readed variable is a variable of the subroutine               */ 
    145115      /*    subroutinename we should write the name of this variable          */ 
    … …  
    147117      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    148118      { 
    149          if ( didvariableadded == 1 ) 
    150          { 
    151             strcat(ligne,","); 
    152          } 
     119         if ( didvariableadded == 1 )   strcat(ligne,","); 
    153120         strcat(ligne,parcours->var->v_nomvar); 
    154121         didvariableadded = 1; 
    … …  
    161128      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    162129      { 
    163          if ( didvariableadded == 1 ) 
    164          { 
    165             strcat(ligne,","); 
    166          } 
     130         if ( didvariableadded == 1 )   strcat(ligne,","); 
    167131         strcat(ligne,parcours->var->v_nomvar); 
    168132         didvariableadded = 1; 
    … …  
    170134      parcours = parcours -> suiv; 
    171135   } 
    172    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n"); 
     136   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n"); 
    173137} 
    174138 
    … …  
    188152/*                                                                            */ 
    189153/******************************************************************************/ 
    190 void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne) 
     154void WriteVariablelist_subloop_Call(char **ligne, size_t line_length) 
    191155{ 
    192156   listvar *parcours; 
    193    char ligne2[10]; 
     157   char ligne2[LONG_M]; 
    194158   int i; 
    195    int compteur ; 
    196  
    197    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n"); 
     159   size_t cur_length; 
     160 
     161   cur_length = line_length; 
     162 
     163   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n"); 
    198164   parcours = List_UsedInSubroutine_Var; 
    199    compteur = 0 ; 
     165 
    200166   while ( parcours ) 
    201167   { 
    … …  
    207173         ) 
    208174      { 
    209          if ( didvariableadded == 1 ) 
     175         if ( didvariableadded == 1 )   strcat(*ligne,","); 
     176         const char *vres = vargridcurgridtabvars(parcours->var, 0); 
     177         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length ) 
    210178         { 
    211             strcat(ligne," , "); 
     179            cur_length += LONG_M; 
     180            *ligne = realloc( *ligne, cur_length*sizeof(char) ); 
    212181         } 
    213          strcat(ligne,vargridcurgridtabvars(parcours->var,0)); 
     182         strcat(*ligne, vres); 
    214183         /* if it is asked in the call of the conv we should give             */ 
    215184         /* scalar in argument, so we should put (1,1,1) after the            */ 
    … …  
    223192             while ( i <=  parcours->var->v_nbdim ) 
    224193             { 
    225                 if ( i == 1 ) strcat(ligne,"( "); 
     194                if ( i == 1 ) strcat(*ligne,"( "); 
    226195                if ( SubloopScalar == 2 ) 
    227196                { 
    228                    strcat(ligne,":"); 
    229                    if ( i != parcours->var->v_nbdim ) strcat(ligne,","); 
     197                   strcat(*ligne,":"); 
     198                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,","); 
    230199                } 
    231200                else 
    232201                { 
    233                    strcat(ligne," lbound( "); 
    234                    strcat(ligne,vargridcurgridtabvars(parcours->var,0)); 
    235                    strcat(ligne,","); 
    236                    strcpy(ligne2,""); 
    237                    sprintf(ligne2,"%d",i); 
    238                    strcat(ligne,ligne2); 
    239                    if ( i != parcours->var->v_nbdim ) strcat(ligne,"),"); 
     202                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i); 
     203                   strcat(*ligne,ligne2); 
     204                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),"); 
    240205                } 
    241                 if ( i == parcours->var->v_nbdim ) strcat(ligne,"))"); 
     206                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))"); 
    242207                i++; 
    243208             } 
    244209         } 
    245210         didvariableadded = 1; 
    246          compteur = compteur +1 ; 
    247          /*if ( retour77 == 0 ) 
    248          { 
    249             strcat(ligne," &"); 
    250             fprintf(outputfile,"\n"); 
    251          } 
    252          else fprintf(outputfile,"\n     & ");*/ 
    253          /*tofich(outputfile,ligne,0);*/ 
    254211      } 
    255212      parcours = parcours -> suiv; 
    256213   } 
    257     
    258 //   Save_Length(ligne,41); 
    259 //   tofich(outputfile,ligne,0); 
    260    /* Now we should replace the last ", &" by " &"                            */ 
    261 /*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); 
    262    if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    263    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Call\n"); 
     214   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n"); 
    264215} 
    265216 
    … …  
    280231/*                                                                            */ 
    281232/******************************************************************************/ 
    282 void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne) 
     233void WriteVariablelist_subloop_Def(char *ligne) 
    283234{ 
    284235   listvar *parcours; 
    285 /*   char ligne[LONG_40M];*/ 
    286    int compteur; 
    287  
    288    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n"); 
     236 
     237   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n"); 
    289238   parcours = List_UsedInSubroutine_Var; 
    290    compteur = 0 ; 
     239 
    291240   while ( parcours ) 
    292241   { 
    … …  
    295244      /*    in the output file                                                */ 
    296245      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    297            (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 
    298          ) 
     246           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) ) 
    299247      { 
    300          if ( didvariableadded == 1 ) 
    301          { 
    302             strcat(ligne,","); 
    303          } 
     248         if ( didvariableadded == 1 )   strcat(ligne,","); 
    304249         strcat(ligne,parcours->var->v_nomvar); 
    305250         didvariableadded = 1; 
    … …  
    307252      parcours = parcours -> suiv; 
    308253   } 
    309  /*  if ( compteur != 3 && compteur != 0 ) 
    310    { 
    311       if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne); 
    312       else fprintf(outputfile,"\n     & %s",ligne); 
    313    }*/ 
    314254   Save_Length(ligne,41); 
    315  //  tofich(outputfile,ligne,0); 
    316  
    317    /* Now we should replace the last ", &" by " &"                            */ 
    318   /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); 
    319    if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    320    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n"); 
    321     
    322 } 
    323  
    324  
     255   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n"); 
     256} 
    325257 
    326258/******************************************************************************/ 
    … …  
    340272void WriteHeadofSubroutineLoop() 
    341273{ 
    342    char ligne[LONG_40M]; 
     274   char ligne[LONG_M]; 
    343275   FILE * subloop; 
    344276 
    345    if ( todebug == 1 ) printf("Enter in WriteHeadofSubroutineLoop\n"); 
    346    tofich(fortranout,"\n",1); 
     277   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n"); 
     278   tofich(fortran_out,"\n",1); 
    347279   /* Open this newfile                                                       */ 
    348280   sprintf(ligne,"Sub_Loop_%s.h",subroutinename); 
    349    subloop = associate(ligne); 
     281   subloop = open_for_write(ligne); 
    350282   /*                                                                         */ 
    351    if (isrecursive)  
    352    { 
    353    sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename); 
    354    } 
    355    else 
    356    { 
    357    sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename); 
    358    } 
     283   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename); 
     284   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename); 
    359285   /*                                                                         */ 
    360    WriteVariablelist_subloop(subloop,ligne); 
    361    WriteVariablelist_subloop_Def(subloop,ligne); 
     286   WriteVariablelist_subloop(ligne); 
     287   WriteVariablelist_subloop_Def(ligne); 
    362288   /*                                                                         */ 
    363      strcat(ligne,")"); 
     289   strcat(ligne,")"); 
    364290   tofich(subloop,ligne,1); 
    365291   /* if USE agrif_Uti l should be add                                        */ 
    366292   AddUseAgrifUtil_0(subloop); 
    367293   /*                                                                         */ 
    368    oldfortranout = fortranout; 
    369    fortranout = subloop; 
    370    if ( todebug == 1 ) printf("Out of WriteHeadofSubroutineLoop\n"); 
     294   oldfortran_out = fortran_out; 
     295   fortran_out = subloop; 
     296   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n"); 
    371297} 
    372298 
    … …  
    386312void closeandcallsubloopandincludeit_0(int suborfun) 
    387313{ 
    388    char ligne[LONG_40M]; 
    389  
    390    if ( firstpass == 0 ) 
    391    { 
    392  
    393    if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 
     314   char *ligne; 
     315 
     316   if ( firstpass == 1 )    return; 
     317   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n"); 
     318 
     319   ligne = (char*) calloc(LONG_M, sizeof(char)); 
     320 
    394321   if ( IsTabvarsUseInArgument_0() == 1 ) 
    395322   { 
    396323      /* We should remove the key word end subroutine                         */ 
    397       RemoveWordCUR_0(fortranout,(long)(-(pos_cur-pos_endsubroutine)), 
    398                                           pos_cur-pos_endsubroutine); 
     324      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine); 
    399325      /* We should close the loop subroutine                                  */ 
    400       sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename); 
    401       tofich(fortranout,ligne,1); 
    402       fclose(fortranout); 
    403       fortranout = oldfortranout; 
    404  
    405  
    406       AddUseAgrifUtilBeforeCall_0(fortranout); 
    407       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
     326      tofich(fortran_out,"\n",1); 
     327      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); 
     328      tofich(fortran_out,ligne,1); 
     329      fclose(fortran_out); 
     330      fortran_out = oldfortran_out; 
     331 
     332      AddUseAgrifUtilBeforeCall_0(fortran_out); 
    408333      WriteArgumentDeclaration_beforecall(); 
     334      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
    409335      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
    410                      fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n"); 
     336            fprintf(fortran_out,"      call Agrif_Init_Grids()\n"); 
    411337      /* Now we add the call af the new subroutine                            */ 
    412       sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
     338      tofich(fortran_out,"\n",1); 
     339      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename); 
    413340      /* Write the list of the local variables used in this new subroutine    */ 
    414       WriteVariablelist_subloop(fortranout,ligne); 
     341      WriteVariablelist_subloop(ligne); 
    415342      /* Write the list of the global tables used in this new subroutine      */ 
    416343      /*    in doloop                                                         */ 
    417       WriteVariablelist_subloop_Call(fortranout,ligne); 
     344      WriteVariablelist_subloop_Call(&ligne, LONG_M); 
    418345      /* Close the parenthesis of the new subroutine called                   */ 
    419        strcat(ligne,")"); 
    420        
    421       tofich(fortranout,ligne,1); 
     346      strcat(ligne,")\n"); 
     347      tofich(fortran_out,ligne,1); 
     348      /* we should include the above file in the original code                */ 
    422349 
    423350      /* We should close the original subroutine                              */ 
    424       if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s" 
    425                                                                ,subroutinename); 
    426       if ( suborfun == 2 ) sprintf(ligne,"\n      end"); 
    427       if ( suborfun == 1 ) sprintf(ligne,"\n      end subroutine %s" 
    428                                                                ,subroutinename); 
    429       if ( suborfun == 0 ) sprintf(ligne,"\n      end function %s" 
    430                                                                ,subroutinename); 
    431       tofich(fortranout,ligne,1); 
    432       /* we should include the above file in the original code                */ 
    433       sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename); 
    434       tofich(fortranout,ligne,1); 
    435       } 
    436     oldfortranout = (FILE *)NULL;       
    437    if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    438    } 
    439     
    440 } 
    441  
    442  
    443  
     351      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename); 
     352      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n"); 
     353      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename); 
     354      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename); 
     355 
     356      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename); 
     357    } 
     358    oldfortran_out = (FILE *)NULL; 
     359    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n"); 
     360} 
    444361 
    445362void closeandcallsubloop_contains_0() 
    446363{ 
    447    char ligne[LONG_40M]; 
    448  
    449    if ( firstpass == 0 ) 
    450    { 
    451    if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 
     364   char *ligne; 
     365 
     366   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n"); 
    452367   if ( IsTabvarsUseInArgument_0() == 1 ) 
    453368   { 
    454       Remove_Word_Contains_0(); 
    455       sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename); 
    456       tofich(fortranout,ligne,1); 
    457       fclose(fortranout); 
    458       fortranout = oldfortranout; 
    459  
    460       AddUseAgrifUtilBeforeCall_0(fortranout); 
    461       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    462                                                        "      IMPLICIT NONE\n"); 
    463       WriteLocalParamDeclaration(); 
    464       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
     369      ligne = (char*) calloc(LONG_M, sizeof(char)); 
     370      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains' 
     371      tofich(fortran_out,"\n",1); 
     372      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); 
     373      tofich(fortran_out,ligne,1); 
     374      fclose(fortran_out); 
     375      fortran_out = oldfortran_out; 
     376 
     377      AddUseAgrifUtilBeforeCall_0(fortran_out); 
     378 
     379      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     380      WriteLocalParamDeclaration(fortran_out); 
    465381      WriteArgumentDeclaration_beforecall(); 
    466       WriteSubroutineDeclaration(0); 
     382      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
     383/*      WriteSubroutineDeclaration(0);*/ 
    467384      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
    468                      fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n"); 
     385          fprintf(fortran_out,"      call Agrif_Init_Grids()\n"); 
    469386      /* Now we add the call af the new subroutine                            */ 
    470       if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &" 
    471                                                                ,subroutinename); 
    472       else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
    473       fprintf(fortranout,ligne); 
     387      tofich(fortran_out,"\n",1); 
     388      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename); 
    474389      /* Write the list of the local variables used in this new subroutine    */ 
    475       WriteVariablelist_subloop(fortranout,ligne); 
     390      WriteVariablelist_subloop(ligne); 
    476391      /* Write the list of the global tables used in this new subroutine      */ 
    477392      /*    in doloop                                                         */ 
    478       WriteVariablelist_subloop_Call(fortranout,ligne); 
     393      WriteVariablelist_subloop_Call(&ligne, LONG_M); 
    479394      /* Close the parenthesis of the new subroutine called                   */ 
    480       sprintf(ligne,")"); 
    481       tofich(fortranout,ligne,1); 
     395      strcat(ligne,")\n"); 
     396      tofich(fortran_out,ligne,1); 
    482397      /* We should close the original subroutine                              */ 
    483       sprintf(ligne,"\n      contains"); 
    484       tofich(fortranout,ligne,1); 
     398      fprintf(fortran_out, "      contains\n"); 
    485399      /* we should include the above file in the original code                */ 
    486       sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename); 
    487       tofich(fortranout,ligne,1); 
     400      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename); 
    488401      } 
    489    oldfortranout = (FILE *)NULL; 
    490    if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    491    } 
    492 } 
     402   oldfortran_out = (FILE *)NULL; 
     403   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n"); 
     404} 

  • vendors/AGRIF/current/LIB/UtilAgrif.c

    r2671 r4777  
    4545/*                                                                            */ 
    4646/******************************************************************************/ 
    47 int Vartonumber(char *tokname) 
     47int Vartonumber(const char *tokname) 
    4848{ 
    4949   int agrifintheword; 
    … …  
    6868   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1; 
    6969   else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1; 
    70    else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1; 
    71    else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1; 
     70   else if ( !strcasecmp(tokname,"Agrif_init_grids")     ) agrifintheword = 1; 
     71   else if ( !strcasecmp(tokname,"Agrif_step")           ) agrifintheword = 1; 
     72/**************************************************/ 
     73/* adding specific adjoint agrif subroutine names */ 
     74/**************************************************/ 
     75   else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj")    ) agrifintheword = 1; 
     76   else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1; 
    7277 
    7378   return agrifintheword; 
    … …  
    8590/*                                                                            */ 
    8691/******************************************************************************/ 
    87 int Agrif_in_Tok_NAME(char *tokname) 
    88 { 
    89    int agrifintheword; 
    90  
    91    if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1; 
    92    else agrifintheword = 0; 
    93  
    94    return agrifintheword; 
     92int Agrif_in_Tok_NAME(const char *tokname) 
     93{ 
     94    return ( strncasecmp(tokname,"Agrif_",6) == 0 ); 
    9595} 
    9696 
    … …  
    104104/*                                                                            */ 
    105105/******************************************************************************/ 
    106 void ModifyTheVariableName_0(char *ident, int lengthname) 
    107 { 
    108    listvar *newvar; 
    109    int out; 
    110     
    111    printf("ICI ident = %s\n",ident); 
    112     
    113    if ( firstpass == 0 ) 
    114    { 
    115       newvar = List_Global_Var; 
    116       out=0; 
    117       while ( newvar && out == 0 ) 
    118       { 
    119          if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    120          else newvar=newvar->suiv; 
    121       } 
    122        printf("out1 = %d\n",out); 
    123       if ( out == 0 ) 
    124       { 
    125          newvar = List_ModuleUsed_Var; 
    126          while ( newvar && out == 0 ) 
    127          { 
     106void ModifyTheVariableName_0(const char *ident, int lengthname) 
     107{ 
     108    listvar *newvar; 
     109    int out; 
     110 
     111    if ( firstpass )  return; 
     112 
     113    newvar = List_Global_Var; 
     114    out = 0; 
     115    while ( newvar && out == 0 ) 
     116    { 
     117        if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1; 
     118        else newvar = newvar->suiv; 
     119    } 
     120    if ( out == 0 ) 
     121    { 
     122        newvar = List_ModuleUsed_Var; 
     123        while ( newvar && out == 0 ) 
     124        { 
    128125            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    129             else newvar=newvar->suiv; 
    130          } 
    131       } 
    132       if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return; 
    133  
    134       if ( out == 0 ) 
    135       { 
    136          newvar = List_Common_Var; 
    137          while ( newvar && out == 0 ) 
    138          { 
     126            else newvar = newvar->suiv; 
     127        } 
     128    } 
     129    if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return; 
     130 
     131    if ( out == 0 ) 
     132    { 
     133        newvar = List_Common_Var; 
     134        while ( newvar && out == 0 ) 
     135        { 
    139136            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    140             else newvar=newvar->suiv; 
    141          } 
    142       } 
    143  
    144       if ( out == 0 ) 
    145       { 
    146          newvar = List_ModuleUsedInModuleUsed_Var; 
    147          while ( newvar && out == 0 ) 
    148          { 
     137            else newvar = newvar->suiv; 
     138        } 
     139    } 
     140    if ( out == 0 ) 
     141    { 
     142        newvar = List_ModuleUsedInModuleUsed_Var; 
     143        while ( newvar && out == 0 ) 
     144        { 
    149145            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    150             else newvar=newvar->suiv; 
    151          } 
    152       } 
    153  
    154       if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 
    155       { 
    156       printf("ICIC3\n"); 
    157          /* remove the variable                                               */ 
    158          RemoveWordCUR_0(fortranout,(long)(-lengthname), 
    159                                lengthname); 
    160          fseek(fortranout,(long)(-lengthname),SEEK_CUR); 
    161          /* then write the new name                                           */ 
    162          if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 
    163             fprintf(fortranout,"%d",newvar->var->v_indicetabvars); 
    164          else 
    165          { 
     146            else newvar = newvar->suiv; 
     147        } 
     148    } 
     149    if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 
     150    { 
     151        // remove the variable 
     152        RemoveWordCUR_0(fortran_out,lengthname); 
     153        // then write the new name 
     154        if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 
     155            fprintf(fortran_out,"%d",newvar->var->v_indicetabvars); 
     156        else 
     157        { 
    166158            if ( retour77 == 0 ) 
    167             { 
    168                fprintf(fortranout," Agrif_tabvars & \n      "); 
    169             } 
     159                fprintf(fortran_out,"Agrif_%s & \n      ", tabvarsname(newvar->var)); 
    170160            else 
    171161            { 
    172                fprintf(fortranout,"Agrif_tabvars"); 
    173                fprintf(fortranout," \n     & "); 
     162               fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var)); 
     163               fprintf(fortran_out," \n     & "); 
    174164            } 
    175             fprintf(fortranout,"%s", 
    176                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    177             colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    178          } 
    179       } 
    180       else 
    181       { 
    182          /* we should look in the List_ModuleUsed_Var                         */ 
    183          if ( inagrifcallargument != 1 ) 
    184          { 
     165            fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     166        } 
     167    } 
     168    else 
     169    { 
     170        // we should look in the List_ModuleUsed_Var 
     171        if ( inagrifcallargument != 1 ) 
     172        { 
    185173            newvar = List_ModuleUsed_Var; 
    186174            while ( newvar && out == 0 ) 
    187175            { 
    188                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    189                else newvar=newvar->suiv; 
     176                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
     177                else newvar = newvar->suiv; 
    190178            } 
    191             if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 
     179            if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type")) 
    192180            { 
    193             printf("ICICIC4 %s\n",newvar->var->v_typevar); 
    194                /* remove the variable                                         */ 
    195                RemoveWordCUR_0(fortranout,(long)(-lengthname), 
    196                                      lengthname); 
    197                fseek(fortranout,(long)(-lengthname),SEEK_CUR); 
    198                /* then write the new name                                     */ 
    199                if ( retour77 == 0 ) 
    200                { 
    201                   fprintf(fortranout," Agrif_tabvars & \n      "); 
    202                } 
    203                else 
    204                { 
    205                   fprintf(fortranout," \n     & Agrif_tabvars"); 
    206                } 
    207                fprintf(fortranout,"%s", 
    208                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    209                colnum = strlen( 
    210                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     181                // remove the variable 
     182                RemoveWordCUR_0(fortran_out,lengthname); 
     183                // then write the new name 
     184                if ( retour77 == 0 ) 
     185                    fprintf(fortran_out,"Agrif_%s & \n      ",tabvarsname(newvar->var)); 
     186                else 
     187                { 
     188                    fprintf(fortran_out," \n     &Agrif_%s",tabvarsname(newvar->var)); 
     189                } 
     190                fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    211191            } 
    212          } 
    213       } 
    214    } 
    215 } 
    216  
    217 /******************************************************************************/ 
    218 /*                     ModifyTheVariableName_0                                */ 
    219 /******************************************************************************/ 
    220 /* Firstpass 0                                                                */ 
    221 /******************************************************************************/ 
    222 /*                                                                            */ 
    223 /*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */ 
    224 /*                                                                            */ 
    225 /******************************************************************************/ 
    226 void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident) 
    227 { 
    228    listvar *newvar; 
    229    int out; 
    230     
    231    if ( firstpass == 0 ) 
    232    { 
    233       newvar = List_Global_Var; 
    234       out=0; 
    235       while ( newvar && out == 0 ) 
    236       { 
    237          if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    238          else newvar=newvar->suiv; 
    239       } 
    240  
    241       if ( out == 0 ) 
    242       { 
    243          newvar = List_ModuleUsed_Var; 
    244          while ( newvar && out == 0 ) 
    245          { 
    246             if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    247             else newvar=newvar->suiv; 
    248          } 
    249       } 
    250       if ( out == 0 ) 
    251       { 
    252          newvar = List_Common_Var; 
    253          while ( newvar && out == 0 ) 
    254          { 
    255             if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    256             else newvar=newvar->suiv; 
    257          } 
    258       } 
    259  
    260       if ( out == 0 ) 
    261       { 
    262          newvar = List_ModuleUsedInModuleUsed_Var; 
    263          while ( newvar && out == 0 ) 
    264          { 
    265             if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    266             else newvar=newvar->suiv; 
    267          } 
    268       } 
    269  
    270       if ( out == 1 ) 
    271       { 
    272          /* remove the variable                                               */ 
    273          RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 
    274                                strlen(ident)); 
    275          fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 
    276          /* then write the new name                                           */ 
    277          if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 
    278             fprintf(fortranout,"%d",newvar->var->v_indicetabvars); 
    279          else 
    280          { 
    281             if ( retour77 == 0 ) 
    282             { 
    283                fprintf(fortranout," Agrif_tabvars & \n      "); 
    284             } 
    285             else 
    286             { 
    287                fprintf(fortranout,"Agrif_tabvars"); 
    288                fprintf(fortranout," \n     & "); 
    289             } 
    290             fprintf(fortranout,"%s", 
    291                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    292             colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    293          } 
    294       } 
    295       else 
    296       { 
    297          /* we should look in the List_ModuleUsed_Var                         */ 
    298          if ( inagrifcallargument != 1 ) 
    299          { 
    300             newvar = List_ModuleUsed_Var; 
    301             while ( newvar && out == 0 ) 
    302             { 
    303                if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    304                else newvar=newvar->suiv; 
    305             } 
    306             if ( out == 1 ) 
    307             { 
    308                /* remove the variable                                         */ 
    309                RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 
    310                                      strlen(ident)); 
    311                fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 
    312                /* then write the new name                                     */ 
    313                if ( retour77 == 0 ) 
    314                { 
    315                   fprintf(fortranout," Agrif_tabvars & \n      "); 
    316                } 
    317                else 
    318                { 
    319                   fprintf(fortranout," \n     & Agrif_tabvars"); 
    320                } 
    321                fprintf(fortranout,"%s", 
    322                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    323                colnum = strlen( 
    324                              vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
    325             } 
    326          } 
    327       } 
    328    } 
    329 } 
    330  
    331  
     192        } 
     193    } 
     194} 
    332195 
    333196/******************************************************************************/ 
    … …  
    348211/*                                                                            */ 
    349212/******************************************************************************/ 
    350 void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod) 
    351 { 
    352   listnom *listnomtmp; 
    353   listnom *parcours; 
    354  
    355   if ( firstpass == 1 ) 
    356   { 
    357   if ( !List_SubroutineWhereAgrifUsed ) 
    358   { 
    359      listnomtmp=(listnom *)malloc(sizeof(listnom)); 
    360      strcpy(listnomtmp->o_nom,sub); 
    361      Save_Length(sub,23); 
    362      strcpy(listnomtmp->o_module,mod); 
    363      Save_Length(mod,24); 
    364      listnomtmp->suiv = NULL; 
    365      List_SubroutineWhereAgrifUsed  =  listnomtmp; 
    366   } 
    367   else 
    368   { 
    369     parcours = List_SubroutineWhereAgrifUsed; 
    370     while ( parcours && strcasecmp(parcours->o_nom,sub) ) 
    371     { 
    372        parcours = parcours->suiv; 
    373     } 
    374     if ( !parcours ) 
    375     { 
    376        listnomtmp=(listnom *)malloc(sizeof(listnom)); 
    377        strcpy(listnomtmp->o_nom,sub); 
    378        Save_Length(sub,23); 
    379        strcpy(listnomtmp->o_module,mod); 
    380        Save_Length(mod,24); 
    381        listnomtmp->suiv = List_SubroutineWhereAgrifUsed; 
    382        List_SubroutineWhereAgrifUsed  =  listnomtmp; 
    383     } 
    384   } 
    385   } 
     213void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod) 
     214{ 
     215    listnom *listnomtmp; 
     216    listnom *parcours; 
     217 
     218    if ( firstpass == 1 ) 
     219    { 
     220        if ( !List_SubroutineWhereAgrifUsed ) 
     221        { 
     222            listnomtmp = (listnom*) calloc(1, sizeof(listnom)); 
     223            strcpy(listnomtmp->o_nom, sub); 
     224            strcpy(listnomtmp->o_module, mod); 
     225            listnomtmp->suiv = NULL; 
     226            List_SubroutineWhereAgrifUsed = listnomtmp; 
     227        } 
     228        else 
     229        { 
     230            parcours = List_SubroutineWhereAgrifUsed; 
     231            while ( parcours && strcasecmp(parcours->o_nom,sub) ) 
     232            { 
     233                parcours = parcours->suiv; 
     234            } 
     235            if ( !parcours ) 
     236            { 
     237                listnomtmp = (listnom*) calloc(1, sizeof(listnom)); 
     238                strcpy(listnomtmp->o_nom, sub); 
     239                strcpy(listnomtmp->o_module, mod); 
     240                listnomtmp->suiv = List_SubroutineWhereAgrifUsed; 
     241                List_SubroutineWhereAgrifUsed = listnomtmp; 
     242            } 
     243        } 
     244    } 
    386245} 
    387246 
    … …  
    411270     parcours = List_SubroutineWhereAgrifUsed; 
    412271     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) ) 
    413                                                     parcours = parcours -> suiv; 
     272     { 
     273        parcours = parcours -> suiv; 
     274     } 
    414275     if ( parcours && parcours->o_val != 0 ) 
    415                                    fprintf(fileout,"\n      USE Agrif_Util \n"); 
     276        fprintf(fileout,"\n      use Agrif_Util\n"); 
     277     else 
     278        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n"); 
    416279  } 
    417280} 
    … …  
    419282void  AddUseAgrifUtilBeforeCall_0(FILE *fileout) 
    420283{ 
    421   listusemodule *parcours; 
    422  
    423   int out; 
    424  
    425   if ( firstpass == 0 ) 
    426   { 
    427      parcours = List_NameOfModuleUsed; 
    428      out = 0 ; 
    429      while ( parcours && out == 0 ) 
    430      { 
    431         if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     && 
    432              !strcasecmp(parcours->u_modulename,curmodulename)   && 
    433              !strcasecmp(parcours->u_cursubroutine,subroutinename) 
    434             ) out = 1; 
    435         else parcours = parcours->suiv; 
    436      } 
    437      if ( out == 0 ) 
    438      { 
    439         fprintf(fileout,"\n      USE Agrif_Util \n"); 
    440      } 
    441   } 
     284    listusemodule *parcours; 
     285 
     286    int out; 
     287 
     288    if ( firstpass == 0 ) 
     289    { 
     290        parcours = List_NameOfModuleUsed; 
     291        out = 0 ; 
     292        while ( parcours && out == 0 ) 
     293        { 
     294            if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util")   && 
     295                 !strcasecmp(parcours->u_modulename, curmodulename) && 
     296                 !strcasecmp(parcours->u_cursubroutine, subroutinename) ) 
     297                out = 1; 
     298            else 
     299                parcours = parcours->suiv; 
     300        } 
     301        if ( out == 0 ) 
     302        { 
     303            fprintf(fileout,"\n      use Agrif_Util\n"); 
     304        } 
     305    } 
    442306} 
    443307 
    … …  
    451315/*                                                                            */ 
    452316/******************************************************************************/ 
    453 void NotifyAgrifFunction_0(char *ident) 
    454 { 
    455    if ( firstpass == 0 ) 
    456    { 
    457       if ( !strcasecmp(ident,"Agrif_parent") ) 
    458       { 
    459          InAgrifParentDef = 1; 
    460          pos_curagrifparent = setposcur()-12; 
    461       } 
    462       else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 
    463       { 
    464          InAgrifParentDef = 2; 
    465          pos_curagrifparent = setposcur()-21; 
    466       } 
    467       else if ( !strcasecmp(ident,"Agrif_Rhox") ) 
    468       { 
    469          InAgrifParentDef = 3; 
    470          pos_curagrifparent = setposcur()-10; 
    471       } 
    472       else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 
    473       { 
    474          InAgrifParentDef = 4; 
    475          pos_curagrifparent = setposcur()-17; 
    476       } 
    477       else if ( !strcasecmp(ident,"Agrif_IRhox") ) 
    478       { 
    479          InAgrifParentDef = 5; 
    480          pos_curagrifparent = setposcur()-11; 
    481       } 
    482       else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 
    483       { 
    484          InAgrifParentDef = 6; 
    485          pos_curagrifparent = setposcur()-18; 
    486       } 
    487       else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 
    488       { 
    489          InAgrifParentDef = 7; 
    490          pos_curagrifparent = setposcur()-10; 
    491       } 
    492       else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 
    493       { 
    494          InAgrifParentDef = 8; 
    495          pos_curagrifparent = setposcur()-17; 
    496       } 
    497       else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 
    498       { 
    499          InAgrifParentDef = 9; 
    500          pos_curagrifparent = setposcur()-11; 
    501       } 
    502       else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 
    503       { 
    504          InAgrifParentDef = 10; 
    505          pos_curagrifparent = setposcur()-18; 
    506       } 
    507       else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 
    508       { 
    509          InAgrifParentDef = 11; 
    510          pos_curagrifparent = setposcur()-10; 
    511       } 
    512       else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 
    513       { 
    514          InAgrifParentDef = 12; 
    515          pos_curagrifparent = setposcur()-17; 
    516       } 
    517       else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 
    518       { 
    519          InAgrifParentDef = 13; 
    520          pos_curagrifparent = setposcur()-11; 
    521       } 
    522       else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 
    523       { 
    524          InAgrifParentDef = 14; 
    525          pos_curagrifparent = setposcur()-18; 
    526       } 
    527       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 
    528       { 
    529          InAgrifParentDef = 15; 
    530          pos_curagrifparent = setposcur()-23; 
    531       } 
    532       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 
    533       { 
    534          InAgrifParentDef = 16; 
    535          pos_curagrifparent = setposcur()-23; 
    536       } 
    537       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 
    538       { 
    539          InAgrifParentDef = 17; 
    540          pos_curagrifparent = setposcur()-23; 
    541       } 
    542       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 
    543       { 
    544          InAgrifParentDef = 18; 
    545          pos_curagrifparent = setposcur()-26; 
    546       } 
    547       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 
    548       { 
    549          InAgrifParentDef = 19; 
    550          pos_curagrifparent = setposcur()-26; 
    551       } 
    552       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 
    553       { 
    554          InAgrifParentDef = 20; 
    555          pos_curagrifparent = setposcur()-26; 
    556       } 
    557       else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 
    558       { 
    559          InAgrifParentDef = 21; 
    560          pos_curagrifparent = setposcur()-19; 
    561       } 
    562       else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 
    563       { 
    564          InAgrifParentDef = 22; 
    565          pos_curagrifparent = setposcur()-17; 
    566       } 
    567       else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 
    568       { 
    569          InAgrifParentDef = 23; 
    570          pos_curagrifparent = setposcur()-15; 
    571       } 
    572       else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 
    573       { 
    574          InAgrifParentDef = 24; 
    575          pos_curagrifparent = setposcur()-15; 
    576       } 
    577       else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 
    578       { 
    579          InAgrifParentDef = 25; 
    580          pos_curagrifparent = setposcur()-15; 
    581       } 
    582       else if ( !strcasecmp(ident,"Agrif_Iz") ) 
    583       { 
    584          InAgrifParentDef = 26; 
    585          pos_curagrifparent = setposcur()-8; 
    586       } 
    587       else if ( !strcasecmp(ident,"Agrif_Iy") ) 
    588       { 
    589          InAgrifParentDef = 27; 
    590          pos_curagrifparent = setposcur()-8; 
    591       } 
    592       else if ( !strcasecmp(ident,"Agrif_Ix") ) 
    593       { 
    594          InAgrifParentDef = 28; 
    595          pos_curagrifparent = setposcur()-8; 
    596       } 
    597       else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 
    598       { 
    599          InAgrifParentDef = 29; 
    600          pos_curagrifparent = setposcur()-20; 
    601       } 
    602       else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 
    603       { 
    604          InAgrifParentDef = 29; 
    605          pos_curagrifparent = setposcur()-19; 
    606       } 
    607       else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 
    608       { 
    609          InAgrifParentDef = 30; 
    610          pos_curagrifparent = setposcur()-13; 
    611       } 
    612    } 
     317void NotifyAgrifFunction_0(const char *ident) 
     318{ 
     319    if ( firstpass == 1 )   return; 
     320 
     321    if ( !strcasecmp(ident,"Agrif_parent") ) 
     322    { 
     323        InAgrifParentDef = 1; 
     324        pos_curagrifparent = setposcur()-12; 
     325    } 
     326    else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 
     327    { 
     328        InAgrifParentDef = 2; 
     329        pos_curagrifparent = setposcur()-21; 
     330    } 
     331    else if ( !strcasecmp(ident,"Agrif_Rhox") ) 
     332    { 
     333        InAgrifParentDef = 3; 
     334        pos_curagrifparent = setposcur()-10; 
     335    } 
     336    else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 
     337    { 
     338        InAgrifParentDef = 4; 
     339        pos_curagrifparent = setposcur()-17; 
     340    } 
     341    else if ( !strcasecmp(ident,"Agrif_IRhox") ) 
     342    { 
     343        InAgrifParentDef = 5; 
     344        pos_curagrifparent = setposcur()-11; 
     345    } 
     346    else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 
     347    { 
     348        InAgrifParentDef = 6; 
     349        pos_curagrifparent = setposcur()-18; 
     350    } 
     351    else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 
     352    { 
     353        InAgrifParentDef = 7; 
     354        pos_curagrifparent = setposcur()-10; 
     355    } 
     356    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 
     357    { 
     358        InAgrifParentDef = 8; 
     359        pos_curagrifparent = setposcur()-17; 
     360    } 
     361    else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 
     362    { 
     363        InAgrifParentDef = 9; 
     364        pos_curagrifparent = setposcur()-11; 
     365    } 
     366    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 
     367    { 
     368        InAgrifParentDef = 10; 
     369        pos_curagrifparent = setposcur()-18; 
     370    } 
     371    else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 
     372    { 
     373        InAgrifParentDef = 11; 
     374        pos_curagrifparent = setposcur()-10; 
     375    } 
     376    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 
     377    { 
     378        InAgrifParentDef = 12; 
     379        pos_curagrifparent = setposcur()-17; 
     380    } 
     381    else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 
     382    { 
     383        InAgrifParentDef = 13; 
     384        pos_curagrifparent = setposcur()-11; 
     385    } 
     386    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 
     387    { 
     388        InAgrifParentDef = 14; 
     389        pos_curagrifparent = setposcur()-18; 
     390    } 
     391    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 
     392    { 
     393        InAgrifParentDef = 15; 
     394        pos_curagrifparent = setposcur()-23; 
     395    } 
     396    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 
     397    { 
     398        InAgrifParentDef = 16; 
     399        pos_curagrifparent = setposcur()-23; 
     400    } 
     401    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 
     402    { 
     403        InAgrifParentDef = 17; 
     404        pos_curagrifparent = setposcur()-23; 
     405    } 
     406    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 
     407    { 
     408        InAgrifParentDef = 18; 
     409        pos_curagrifparent = setposcur()-26; 
     410    } 
     411    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 
     412    { 
     413        InAgrifParentDef = 19; 
     414        pos_curagrifparent = setposcur()-26; 
     415    } 
     416    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 
     417    { 
     418        InAgrifParentDef = 20; 
     419        pos_curagrifparent = setposcur()-26; 
     420    } 
     421    else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 
     422    { 
     423        InAgrifParentDef = 21; 
     424        pos_curagrifparent = setposcur()-19; 
     425    } 
     426    else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 
     427    { 
     428        InAgrifParentDef = 22; 
     429        pos_curagrifparent = setposcur()-17; 
     430    } 
     431    else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 
     432    { 
     433        InAgrifParentDef = 23; 
     434        pos_curagrifparent = setposcur()-15; 
     435    } 
     436    else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 
     437    { 
     438        InAgrifParentDef = 24; 
     439        pos_curagrifparent = setposcur()-15; 
     440    } 
     441    else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 
     442    { 
     443        InAgrifParentDef = 25; 
     444        pos_curagrifparent = setposcur()-15; 
     445    } 
     446    else if ( !strcasecmp(ident,"Agrif_Iz") ) 
     447    { 
     448        InAgrifParentDef = 26; 
     449        pos_curagrifparent = setposcur()-8; 
     450    } 
     451    else if ( !strcasecmp(ident,"Agrif_Iy") ) 
     452    { 
     453        InAgrifParentDef = 27; 
     454        pos_curagrifparent = setposcur()-8; 
     455    } 
     456    else if ( !strcasecmp(ident,"Agrif_Ix") ) 
     457    { 
     458        InAgrifParentDef = 28; 
     459        pos_curagrifparent = setposcur()-8; 
     460    } 
     461    else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 
     462    { 
     463        InAgrifParentDef = 29; 
     464        pos_curagrifparent = setposcur()-20; 
     465    } 
     466    else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 
     467    { 
     468        InAgrifParentDef = 29; 
     469        pos_curagrifparent = setposcur()-19; 
     470    } 
     471    else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 
     472    { 
     473        InAgrifParentDef = 30; 
     474        pos_curagrifparent = setposcur()-13; 
     475    } 
    613476} 
    614477 
    … …  
    622485/*                                                                            */ 
    623486/******************************************************************************/ 
    624 void ModifyTheAgrifFunction_0(char *ident) 
     487void ModifyTheAgrifFunction_0(const char *ident) 
    625488{ 
    626489   if ( InAgrifParentDef != 0 ) 
    627490          AgriffunctionModify_0(ident,InAgrifParentDef); 
    628    /*                                                                         */ 
    629491   InAgrifParentDef = 0; 
    630492} 
    … …  
    700562/*                                                                            */ 
    701563/******************************************************************************/ 
    702 void AgriffunctionModify_0(char *ident,int whichone) 
    703 { 
    704    char toprint[LONG_C]; 
    705    if ( firstpass == 0 ) 
    706    { 
    707       strcpy(toprint,""); 
    708       pos_end = setposcur(); 
    709       fseek(fortranout,pos_curagrifparent,SEEK_SET); 
    710       if ( whichone == 1 || whichone == 2 ) 
    711       { 
    712          /*                                                                   */ 
    713          FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 
    714          if ( !strcasecmp(ident,toprint) ) 
    715          { 
    716             /* la liste des use de cette subroutine                           */ 
    717             strcpy(toprint,""); 
    718             FindAndChangeNameToTabvars(ident, 
    719                                           toprint,List_Common_Var,whichone); 
    720          } 
    721          if ( !strcasecmp(ident,toprint) ) 
    722          { 
    723             /* la liste des use de cette subroutine                           */ 
    724             strcpy(toprint,""); 
    725             FindAndChangeNameToTabvars(ident, 
    726                                           toprint,List_ModuleUsed_Var,whichone); 
    727          } 
    728       } 
    729       else if ( whichone == 3 ) /* Agrif_Rhox                                 */ 
    730       { 
    731          sprintf(toprint,"REAL("); 
    732          if( retour77 == 0 ) strcat(toprint," & \n"); 
    733          else strcat(toprint,"\n     & "); 
    734          strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 
    735       } 
    736       else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */ 
    737       { 
    738          sprintf(toprint,"REAL("); 
    739          if( retour77 == 0 ) strcat(toprint," & \n"); 
    740          else strcat(toprint,"\n     & "); 
    741          strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 
    742       } 
    743       else if ( whichone == 5 ) /* Agrif_Rhox                                 */ 
    744       { 
    745          sprintf(toprint,"Agrif_Curgrid"); 
    746          if( retour77 == 0 ) strcat(toprint," & \n"); 
    747          else strcat(toprint,"\n     & "); 
    748          strcat(toprint,"% spaceref(1)"); 
    749       } 
    750       else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */ 
    751       { 
    752          sprintf(toprint,"Agrif_Curgrid"); 
    753          if( retour77 == 0 ) strcat(toprint," & \n"); 
    754          else strcat(toprint,"\n     & "); 
    755          strcat(toprint,"% parent % spaceref(1)"); 
    756       } 
    757       else if ( whichone == 7 ) /* Agrif_Rhoy                                 */ 
    758       { 
    759          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    760          if( retour77 == 0 ) strcat(toprint," & \n"); 
    761          else strcat(toprint,"\n     & "); 
    762          strcat(toprint,"% spaceref(2))"); 
    763       } 
    764       else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */ 
    765       { 
    766          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    767          if( retour77 == 0 ) strcat(toprint," & \n"); 
    768          else strcat(toprint,"\n     & "); 
    769          strcat(toprint,"% parent % spaceref(2))"); 
    770       } 
    771       else if ( whichone == 9 ) /* Agrif_Rhoy                                 */ 
    772       { 
    773          sprintf(toprint,"Agrif_Curgrid"); 
    774          if( retour77 == 0 ) strcat(toprint," & \n"); 
    775          else strcat(toprint,"\n     & "); 
    776          strcat(toprint,"% spaceref(2)"); 
    777       } 
    778       else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */ 
    779       { 
    780          sprintf(toprint,"Agrif_Curgrid"); 
    781          if( retour77 == 0 ) strcat(toprint," & \n"); 
    782          else strcat(toprint,"\n     & "); 
    783          strcat(toprint,"% parent % spaceref(2)"); 
    784       } 
    785       else if ( whichone == 11 ) /* Agrif_Rhoz                                */ 
    786       { 
    787          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    788          if( retour77 == 0 ) strcat(toprint," & \n"); 
    789          else strcat(toprint,"\n     & "); 
    790          strcat(toprint,"% spaceref(3))"); 
    791       } 
    792       else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */ 
    793       { 
    794          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    795          if( retour77 == 0 ) strcat(toprint," & \n"); 
    796          else strcat(toprint,"\n     & "); 
    797          strcat(toprint,"% parent % spaceref(3))"); 
    798       } 
    799       else if ( whichone == 13 ) /* Agrif_Rhoz                                */ 
    800       { 
    801          sprintf(toprint,"Agrif_Curgrid"); 
    802          if( retour77 == 0 ) strcat(toprint," & \n"); 
    803          else strcat(toprint,"\n     & "); 
    804          strcat(toprint,"% spaceref(3)"); 
    805       } 
    806       else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */ 
    807       { 
    808          sprintf(toprint,"Agrif_Curgrid"); 
    809          if( retour77 == 0 ) strcat(toprint," & \n"); 
    810          else strcat(toprint,"\n     & "); 
    811          strcat(toprint,"% parent % spaceref(3)"); 
    812       } 
    813       else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */ 
    814       { 
    815          sprintf(toprint,"Agrif_Curgrid"); 
    816          if( retour77 == 0 ) strcat(toprint," & \n"); 
    817          else strcat(toprint,"\n     & "); 
    818          strcat(toprint,"% NearRootBorder(1)"); 
    819       } 
    820       else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */ 
    821       { 
    822          sprintf(toprint,"Agrif_Curgrid"); 
    823          if( retour77 == 0 ) strcat(toprint," & \n"); 
    824          else strcat(toprint,"\n     & "); 
    825          strcat(toprint,"% NearRootBorder(2)"); 
    826       } 
    827       else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */ 
    828       { 
    829          sprintf(toprint,"Agrif_Curgrid"); 
    830          if( retour77 == 0 ) strcat(toprint," & \n"); 
    831          else strcat(toprint,"\n     & "); 
    832          strcat(toprint,"% NearRootBorder(3)"); 
    833       } 
    834       else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */ 
    835       { 
    836          sprintf(toprint,"Agrif_Curgrid"); 
    837          if( retour77 == 0 ) strcat(toprint," & \n"); 
    838          else strcat(toprint,"\n     & "); 
     564void AgriffunctionModify_0(const char *ident,int whichone) 
     565{ 
     566    char toprint[LONG_M]; 
     567    if ( firstpass == 0 ) 
     568    { 
     569        strcpy(toprint,""); 
     570        pos_end = setposcur(); 
     571        fseek(fortran_out,pos_curagrifparent,SEEK_SET); 
     572        if ( whichone == 1 || whichone == 2 ) 
     573        { 
     574            FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 
     575            if ( !strcasecmp(ident,toprint) ) 
     576            { 
     577                /* la liste des use de cette subroutine                           */ 
     578                strcpy(toprint,""); 
     579                FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone); 
     580            } 
     581            if ( !strcasecmp(ident,toprint) ) 
     582            { 
     583                /* la liste des use de cette subroutine                           */ 
     584                strcpy(toprint,""); 
     585                FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone); 
     586            } 
     587        } 
     588        else if ( whichone == 3 ) /* Agrif_Rhox                                 */ 
     589        { 
     590            sprintf(toprint,"REAL("); 
     591            if( retour77 == 0 ) strcat(toprint," & \n"); 
     592            else                strcat(toprint,"\n     & "); 
     593            strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 
     594        } 
     595        else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */ 
     596        { 
     597            sprintf(toprint,"REAL("); 
     598            if( retour77 == 0 ) strcat(toprint," & \n"); 
     599            else                strcat(toprint,"\n     & "); 
     600            strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 
     601        } 
     602        else if ( whichone == 5 ) /* Agrif_Rhox                                 */ 
     603        { 
     604            sprintf(toprint,"Agrif_Curgrid"); 
     605            if( retour77 == 0 ) strcat(toprint," & \n"); 
     606            else                strcat(toprint,"\n     & "); 
     607            strcat(toprint,"% spaceref(1)"); 
     608        } 
     609        else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */ 
     610        { 
     611            sprintf(toprint,"Agrif_Curgrid"); 
     612            if( retour77 == 0 ) strcat(toprint," & \n"); 
     613            else                strcat(toprint,"\n     & "); 
     614            strcat(toprint,"% parent % spaceref(1)"); 
     615        } 
     616        else if ( whichone == 7 ) /* Agrif_Rhoy                                 */ 
     617        { 
     618            sprintf(toprint,"REAL(Agrif_Curgrid"); 
     619            if( retour77 == 0 ) strcat(toprint," & \n"); 
     620            else                strcat(toprint,"\n     & "); 
     621            strcat(toprint,"% spaceref(2))"); 
     622        } 
     623        else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */ 
     624        { 
     625            sprintf(toprint,"REAL(Agrif_Curgrid"); 
     626            if( retour77 == 0 ) strcat(toprint," & \n"); 
     627            else                strcat(toprint,"\n     & "); 
     628            strcat(toprint,"% parent % spaceref(2))"); 
     629        } 
     630        else if ( whichone == 9 ) /* Agrif_Rhoy                                 */ 
     631        { 
     632            sprintf(toprint,"Agrif_Curgrid"); 
     633            if( retour77 == 0 ) strcat(toprint," & \n"); 
     634            else                strcat(toprint,"\n     & "); 
     635            strcat(toprint,"% spaceref(2)"); 
     636        } 
     637        else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */ 
     638        { 
     639            sprintf(toprint,"Agrif_Curgrid"); 
     640            if( retour77 == 0 ) strcat(toprint," & \n"); 
     641            else                strcat(toprint,"\n     & "); 
     642            strcat(toprint,"% parent % spaceref(2)"); 
     643        } 
     644        else if ( whichone == 11 ) /* Agrif_Rhoz                                */ 
     645        { 
     646            sprintf(toprint,"REAL(Agrif_Curgrid"); 
     647            if( retour77 == 0 ) strcat(toprint," & \n"); 
     648            else                strcat(toprint,"\n     & "); 
     649            strcat(toprint,"% spaceref(3))"); 
     650        } 
     651        else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */ 
     652        { 
     653            sprintf(toprint,"REAL(Agrif_Curgrid"); 
     654            if( retour77 == 0 ) strcat(toprint," & \n"); 
     655            else                strcat(toprint,"\n     & "); 
     656            strcat(toprint,"% parent % spaceref(3))"); 
     657        } 
     658        else if ( whichone == 13 ) /* Agrif_Rhoz                                */ 
     659        { 
     660            sprintf(toprint,"Agrif_Curgrid"); 
     661            if( retour77 == 0 ) strcat(toprint," & \n"); 
     662            else                strcat(toprint,"\n     & "); 
     663            strcat(toprint,"% spaceref(3)"); 
     664        } 
     665        else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */ 
     666        { 
     667            sprintf(toprint,"Agrif_Curgrid"); 
     668            if( retour77 == 0 ) strcat(toprint," & \n"); 
     669            else                strcat(toprint,"\n     & "); 
     670            strcat(toprint,"% parent % spaceref(3)"); 
     671        } 
     672        else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */ 
     673        { 
     674            sprintf(toprint,"Agrif_Curgrid"); 
     675            if( retour77 == 0 ) strcat(toprint," & \n"); 
     676            else                strcat(toprint,"\n     & "); 
     677            strcat(toprint,"% NearRootBorder(1)"); 
     678        } 
     679        else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */ 
     680        { 
     681            sprintf(toprint,"Agrif_Curgrid"); 
     682            if( retour77 == 0 ) strcat(toprint," & \n"); 
     683            else                strcat(toprint,"\n     & "); 
     684            strcat(toprint,"% NearRootBorder(2)"); 
     685        } 
     686        else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */ 
     687        { 
     688            sprintf(toprint,"Agrif_Curgrid"); 
     689            if( retour77 == 0 ) strcat(toprint," & \n"); 
     690            else                strcat(toprint,"\n     & "); 
     691            strcat(toprint,"% NearRootBorder(3)"); 
     692        } 
     693        else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */ 
     694        { 
     695            sprintf(toprint,"Agrif_Curgrid"); 
     696            if( retour77 == 0 ) strcat(toprint," & \n"); 
     697            else                strcat(toprint,"\n     & "); 
    839698         strcat(toprint,"% DistantRootBorder(1)"); 
    840       } 
    841       else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */ 
    842       { 
    843          sprintf(toprint,"Agrif_Curgrid"); 
    844          if( retour77 == 0 ) strcat(toprint," & \n"); 
    845          else strcat(toprint,"\n     & "); 
    846          strcat(toprint,"% DistantRootBorder(2)"); 
    847       } 
    848       else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */ 
    849       { 
    850          sprintf(toprint,"Agrif_Curgrid"); 
    851          if( retour77 == 0 ) strcat(toprint," & \n"); 
    852          else strcat(toprint,"\n     & "); 
    853          strcat(toprint,"% DistantRootBorder(3)"); 
    854       } 
    855       else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */ 
    856       { 
    857          sprintf(toprint,"Agrif_Curgrid"); 
    858          if( retour77 == 0 ) strcat(toprint," & \n"); 
    859          else strcat(toprint,"\n     & "); 
    860          strcat(toprint,"% parent % grid_id"); 
    861       } 
    862       else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */ 
    863       { 
    864          sprintf(toprint,"Agrif_Curgrid"); 
    865          if( retour77 == 0 ) strcat(toprint," & \n"); 
    866          else strcat(toprint,"\n     & "); 
    867          strcat(toprint,"% grid_id"); 
    868       } 
    869       else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */ 
    870       { 
    871          sprintf(toprint,"Agrif_Curgrid"); 
    872          if( retour77 == 0 ) strcat(toprint," & \n"); 
    873          else strcat(toprint,"\n     & "); 
    874          strcat(toprint,"% parent % ix(3)"); 
    875       } 
    876       else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */ 
    877       { 
    878          sprintf(toprint,"Agrif_Curgrid"); 
    879          if( retour77 == 0 ) strcat(toprint," & \n"); 
    880          else strcat(toprint,"\n     & "); 
    881          strcat(toprint,"% parent % ix(2)"); 
    882       } 
    883       else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */ 
    884       { 
    885          sprintf(toprint,"Agrif_Curgrid"); 
    886          if( retour77 == 0 ) strcat(toprint," & \n"); 
    887          else strcat(toprint,"\n     & "); 
    888          strcat(toprint,"% parent % ix(1)"); 
    889       } 
    890       else if ( whichone == 26 ) /* Agrif_Iz                                  */ 
    891       { 
    892          sprintf(toprint,"Agrif_Curgrid"); 
    893          if( retour77 == 0 ) strcat(toprint," & \n"); 
    894          else strcat(toprint,"\n     & "); 
    895          strcat(toprint," % ix(3)"); 
    896       } 
    897       else if ( whichone == 27 ) /* Agrif_Iy                                  */ 
    898       { 
    899          sprintf(toprint,"Agrif_Curgrid"); 
    900          if( retour77 == 0 ) strcat(toprint," & \n"); 
    901          else strcat(toprint,"\n     & "); 
    902          strcat(toprint,"% ix(2)"); 
    903       } 
    904       else if ( whichone == 28 ) /* Agrif_Ix                                  */ 
    905       { 
    906          sprintf(toprint,"Agrif_Curgrid"); 
    907          if( retour77 == 0 ) strcat(toprint," & \n"); 
    908          else strcat(toprint,"\n     & "); 
    909          strcat(toprint,"% ix(1)"); 
    910       } 
    911       else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */ 
    912       { 
    913          sprintf(toprint,"Agrif_nbfixedgrids"); 
    914       } 
    915       else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */ 
    916       { 
    917          sprintf(toprint,"Agrif_Curgrid"); 
    918          if( retour77 == 0 ) strcat(toprint," & \n"); 
    919          else strcat(toprint,"\n     & "); 
    920          strcat(toprint,"% ngridstep"); 
    921       } 
    922       /*                                                                      */ 
    923       if ( whichone == 1 || whichone == 2 ) 
    924       { 
    925          Save_Length(toprint,43); 
    926          tofich(fortranout,toprint,2); 
    927       } 
    928       else 
    929       { 
    930 /*         if( retour77 == 0 ) fprintf(fortranout," & \n"); 
    931          else fprintf(fortranout,"\n     & ");*/ 
    932          Save_Length(toprint,43); 
    933          fprintf(fortranout,"%s",toprint); 
    934       } 
    935    } 
    936 } 
    937  
     699        } 
     700        else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */ 
     701        { 
     702            sprintf(toprint,"Agrif_Curgrid"); 
     703            if( retour77 == 0 ) strcat(toprint," & \n"); 
     704            else                strcat(toprint,"\n     & "); 
     705            strcat(toprint,"% DistantRootBorder(2)"); 
     706        } 
     707        else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */ 
     708        { 
     709            sprintf(toprint,"Agrif_Curgrid"); 
     710            if( retour77 == 0 ) strcat(toprint," & \n"); 
     711            else                strcat(toprint,"\n     & "); 
     712            strcat(toprint,"% DistantRootBorder(3)"); 
     713        } 
     714        else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */ 
     715        { 
     716            sprintf(toprint,"Agrif_Curgrid"); 
     717            if( retour77 == 0 ) strcat(toprint," & \n"); 
     718            else                strcat(toprint,"\n     & "); 
     719            strcat(toprint,"% parent % grid_id"); 
     720        } 
     721        else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */ 
     722        { 
     723            sprintf(toprint,"Agrif_Curgrid"); 
     724            if( retour77 == 0 ) strcat(toprint," & \n"); 
     725            else                strcat(toprint,"\n     & "); 
     726            strcat(toprint,"% grid_id"); 
     727        } 
     728        else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */ 
     729        { 
     730            sprintf(toprint,"Agrif_Curgrid"); 
     731            if( retour77 == 0 ) strcat(toprint," & \n"); 
     732            else                strcat(toprint,"\n     & "); 
     733            strcat(toprint,"% parent % ix(3)"); 
     734        } 
     735        else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */ 
     736        { 
     737            sprintf(toprint,"Agrif_Curgrid"); 
     738            if( retour77 == 0 ) strcat(toprint," & \n"); 
     739            else                strcat(toprint,"\n     & "); 
     740            strcat(toprint,"% parent % ix(2)"); 
     741        } 
     742        else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */ 
     743        { 
     744            sprintf(toprint,"Agrif_Curgrid"); 
     745            if( retour77 == 0 ) strcat(toprint," & \n"); 
     746            else                strcat(toprint,"\n     & "); 
     747            strcat(toprint,"% parent % ix(1)"); 
     748        } 
     749        else if ( whichone == 26 ) /* Agrif_Iz                                  */ 
     750        { 
     751            sprintf(toprint,"Agrif_Curgrid"); 
     752            if( retour77 == 0 ) strcat(toprint," & \n"); 
     753            else                strcat(toprint,"\n     & "); 
     754            strcat(toprint," % ix(3)"); 
     755        } 
     756        else if ( whichone == 27 ) /* Agrif_Iy                                  */ 
     757        { 
     758            sprintf(toprint,"Agrif_Curgrid"); 
     759            if( retour77 == 0 ) strcat(toprint," & \n"); 
     760            else                strcat(toprint,"\n     & "); 
     761            strcat(toprint,"% ix(2)"); 
     762        } 
     763        else if ( whichone == 28 ) /* Agrif_Ix                                  */ 
     764        { 
     765            sprintf(toprint,"Agrif_Curgrid"); 
     766            if( retour77 == 0 ) strcat(toprint," & \n"); 
     767            else                strcat(toprint,"\n     & "); 
     768            strcat(toprint,"% ix(1)"); 
     769        } 
     770        else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */ 
     771        { 
     772            sprintf(toprint,"Agrif_nbfixedgrids"); 
     773        } 
     774        else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */ 
     775        { 
     776            sprintf(toprint,"Agrif_Curgrid"); 
     777            if( retour77 == 0 ) strcat(toprint," & \n"); 
     778            else                strcat(toprint,"\n     & "); 
     779            strcat(toprint,"% ngridstep"); 
     780        } 
     781 
     782        Save_Length(toprint,43); 
     783 
     784        if ( whichone == 1 || whichone == 2 )   tofich(fortran_out,toprint,0); 
     785        else                                    fprintf(fortran_out,"%s",toprint); 
     786    } 
     787} 
    938788 
    939789/******************************************************************************/ 
    … …  
    946796/*                                                                            */ 
    947797/******************************************************************************/ 
    948 void Instanciation_0(char *ident) 
    949 { 
    950    listvar *newvar; 
    951    int out; 
    952  
    953    if ( firstpass == 0 && sameagrifargument == 1 ) 
    954    { 
    955       newvar = List_Global_Var; 
    956  
    957       out=0; 
    958       while ( newvar && out == 0 ) 
    959       { 
    960          if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    961          else newvar=newvar->suiv; 
    962       } 
    963  
    964       if ( out == 0 ) 
    965       { 
    966          newvar = List_Common_Var; 
    967  
    968          out=0; 
    969          while ( newvar && out == 0 ) 
    970          { 
     798void Instanciation_0(const char *ident) 
     799{ 
     800    listvar *newvar; 
     801    int out; 
     802 
     803    if ( firstpass == 0 && sameagrifargument == 1 ) 
     804    { 
     805        newvar = List_Global_Var; 
     806        out = 0; 
     807        while ( newvar && out == 0 ) 
     808        { 
    971809            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    972             else newvar=newvar->suiv; 
    973          } 
    974       } 
    975       if ( out == 0 ) 
    976       { 
    977          newvar = List_ModuleUsed_Var; 
    978  
    979          out=0; 
    980          while ( newvar && out == 0 ) 
    981          { 
    982             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    983             else newvar=newvar->suiv; 
    984          } 
    985       } 
    986  
    987       if ( out == 1 ) 
    988       { 
    989          /* then write the instanciation                                      */ 
    990          fprintf(fortranout,"\n      %s = %s",ident, 
    991                                           vargridcurgridtabvars(newvar->var,3)); 
    992          colnum = 0; 
    993       } 
    994    } 
    995    sameagrifargument = 0; 
    996 } 
     810            else newvar = newvar->suiv; 
     811        } 
     812        if ( out == 0 ) 
     813        { 
     814            newvar = List_Common_Var; 
     815            while ( newvar && out == 0 ) 
     816            { 
     817                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
     818                else newvar = newvar->suiv; 
     819            } 
     820        } 
     821        if ( out == 0 ) 
     822        { 
     823            newvar = List_ModuleUsed_Var; 
     824            while ( newvar && out == 0 ) 
     825            { 
     826                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
     827                else newvar = newvar->suiv; 
     828            } 
     829        } 
     830//         if ( out == 1 ) 
     831//         { 
     832//             /* then write the instanciation                                      */ 
     833//             fprintf(fortran_out,"\n      %s = %s",ident,vargridcurgridtabvars(newvar->var,3)); 
     834//             printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3)); 
     835//         } 
     836    } 
     837    sameagrifargument = 0; 
     838} 

  • vendors/AGRIF/current/LIB/UtilCharacter.c

    r2671 r4777  
    4646/*                                                                            */ 
    4747/******************************************************************************/ 
    48 /* if  whichone = 0 ----> Agrif_tabvars(i) % var % array2                     */ 
    49 /*                                                                            */ 
    50 /* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % var % array2         */ 
    51 /*                                                                            */ 
    52 /******************************************************************************/ 
    53 void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C], 
     48/* if  whichone = 0 ----> Agrif_tabvars(i) % array2                           */ 
     49/*                                                                            */ 
     50/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2               */ 
     51/*                                                                            */ 
     52/******************************************************************************/ 
     53void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M], 
    5454                                              listvar * listtosee, int whichone) 
    5555{ 
    … …  
    7171            { 
    7272               out = 1; 
    73                strcat(toprint,vargridcurgridtabvars(newvar->var,whichone)); 
     73               strcat(toprint,vargridcurgridtabvars(newvar->var, whichone)); 
    7474            } 
    7575            else newvar=newvar->suiv; 
    … …  
    9292/*                                                                            */ 
    9393/******************************************************************************/ 
    94 char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread, 
    95                                                                    int whichone) 
    96 { 
    97    char toprinttmp[LONG_4C]; 
    98    int i; 
    99    char chartmp[2]; 
    100  
    101    i=0; 
    102    strcpy(toprintglob,""); 
    103    strcpy(toprinttmp,""); 
    104  
    105    /*                                                                         */ 
    106    while ( i < strlen(nom) ) 
    107    { 
    108       if ( nom[i] == '+' ) 
    109       { 
    110         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    111          strcpy(toprinttmp,""); 
    112          strcat(toprintglob,"+"); 
    113       } 
    114       else if ( nom[i] == '-' ) 
    115       { 
    116          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    117          strcpy(toprinttmp,""); 
    118          strcat(toprintglob,"-"); 
    119       } 
    120       else if ( nom[i] == '*' ) 
    121       { 
    122          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    123          strcpy(toprinttmp,""); 
    124          strcat(toprintglob,"*"); 
    125       } 
    126       else if ( nom[i] == '/' ) 
    127       { 
    128          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    129          strcpy(toprinttmp,""); 
    130          strcat(toprintglob,"/"); 
    131       } 
    132       else if ( nom[i] == '(' ) 
    133       { 
    134          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    135          strcpy(toprinttmp,""); 
    136          strcat(toprintglob,"("); 
    137       } 
    138       else if ( nom[i] == ')' ) 
    139       { 
    140          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    141          strcpy(toprinttmp,""); 
    142          strcat(toprintglob,")"); 
    143       } 
    144       else if ( nom[i] == ':' ) 
    145       { 
    146          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    147          strcpy(toprinttmp,""); 
    148          strcat(toprintglob,":"); 
    149       } 
    150       else if ( nom[i] == ',' ) 
    151       { 
    152          FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    153          strcpy(toprinttmp,""); 
    154          strcat(toprintglob,","); 
    155       } 
    156       else 
    157       { 
    158          sprintf(chartmp,"%c",nom[i]); 
    159          strcat(toprinttmp,chartmp); 
    160       } 
    161       /*                                                                      */ 
    162       i=i+1; 
    163    } 
    164    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone); 
    165    strcpy(toprinttmp,""); 
    166  
    167    Save_Length(toprinttmp,44); 
    168    Save_Length(toprintglob,39); 
    169  
    170    /*                                                                         */ 
    171    return toprintglob; 
     94const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread) 
     95{ 
     96    char toprinttmp[LONG_M]; 
     97    char chartmp[2]; 
     98    size_t i = 0; 
     99 
     100    strcpy(toprintglob, ""); 
     101    strcpy(toprinttmp,  ""); 
     102 
     103    while ( i < strlen(nom) ) 
     104    { 
     105        if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') || 
     106             (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') ) 
     107        { 
     108            FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0); 
     109            strcpy(toprinttmp, ""); 
     110            sprintf(chartmp, "%c", nom[i]); 
     111            strcat(toprintglob, chartmp); 
     112        } 
     113        else 
     114        { 
     115            sprintf(chartmp, "%c", nom[i]); 
     116            strcat(toprinttmp, chartmp); 
     117        } 
     118        i += 1; 
     119    } 
     120    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0); 
     121    strcpy(toprinttmp,""); 
     122 
     123    Save_Length(toprinttmp,44); 
     124    Save_Length(toprintglob,39); 
     125 
     126    return toprintglob; 
    172127} 
    173128 
    … …  
    181136/*                                                                            */ 
    182137/******************************************************************************/ 
    183 int IsVariableReal(char *nom) 
    184 { 
    185    int Real; 
    186  
    187    Real = 0; 
    188    if ( ( nom[0] >= 'a' && nom[0] <= 'h' ) || 
     138int IsVariableReal(const char *nom) 
     139{ 
     140    return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) || 
    189141        ( nom[0] >= 'A' && nom[0] <= 'H' ) || 
    190142        ( nom[0] >= 'o' && nom[0] <= 'z' ) || 
    191         ( nom[0] >= 'O' && nom[0] <= 'Z' ) 
    192        ) 
    193        { 
    194           Real = 1; 
    195        } 
    196    /*                                                                         */ 
    197    return Real; 
     143        ( nom[0] >= 'O' && nom[0] <= 'Z' ) ); 
    198144} 
    199145/******************************************************************************/ 
    … …  
    206152/*                                                                            */ 
    207153/******************************************************************************/ 
    208 void IsVarInUseFile(char *nom) 
     154void IsVarInUseFile(const char *nom) 
    209155{ 
    210156   listvar *parcours; 
    … …  
    217163   while( parcours && out == 0 ) 
    218164   { 
    219       if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ; 
     165      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; 
    220166     else parcours=parcours->suiv; 
    221167   } 
    … …  
    225171      while( parcours && out == 0 ) 
    226172      { 
     173         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; 
     174        else parcours=parcours->suiv; 
     175      } 
     176   } 
     177   if ( out == 0 ) 
     178   { 
     179      parcours = List_GlobalParameter_Var; 
     180      while( parcours && out == 0 ) 
     181      { 
    227182         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ; 
    228183        else parcours=parcours->suiv; 
    … …  
    231186   if ( out == 0 ) 
    232187   { 
    233       parcours = List_GlobalParameter_Var; 
    234       while( parcours && out == 0 ) 
    235       { 
    236          if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ; 
    237         else parcours=parcours->suiv; 
    238       } 
    239    } 
    240    if ( out == 0 ) 
    241    { 
    242188      parcours = List_Parameter_Var; 
    243189      while( parcours && out == 0 ) 
    244190      { 
    245          if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ; 
     191         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; 
    246192        else parcours=parcours->suiv; 
    247193      } 
    … …  
    252198      while( parcoursparam && out == 0 ) 
    253199      { 
    254          if ( !strcasecmp(nom,parcoursparam->p_name) ) out =2 ; 
     200         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ; 
    255201         else parcoursparam=parcoursparam->suiv; 
    256202      } 
    … …  
    261207      while( parcours && out == 0 ) 
    262208      { 
    263          if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =2 ; 
     209         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ; 
    264210        else parcours=parcours->suiv; 
    265211      } 
    … …  
    270216      while( parcoursparam && out != 1 ) 
    271217      { 
    272          if ( !strcasecmp(nom,parcoursparam->p_name) ) out =1 ; 
     218         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ; 
    273219         else parcoursparam=parcoursparam->suiv; 
    274220      } 
    … …  
    299245/*                                                                            */ 
    300246/******************************************************************************/ 
    301 listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout) 
    302 { 
    303    char toprinttmp[LONG_4C]; 
    304    int i; 
     247listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout) 
     248{ 
     249   char toprinttmp[LONG_M]; 
    305250   char chartmp[2]; 
    306  
    307    i=0; 
     251   size_t i = 0; 
     252 
    308253   strcpy(toprinttmp,""); 
    309    /*                                                                         */ 
     254 
    310255   while ( i < strlen(nom) ) 
    311256   { 
    … …  
    320265         ) 
    321266      { 
    322  
    323267         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) 
    324268         { 
    … …  
    331275         sprintf(chartmp,"%c",nom[i]); 
    332276         strcat(toprinttmp,chartmp); 
    333  
    334       } 
    335       /*                                                                      */ 
     277      } 
    336278      i=i+1; 
    337279   } 
    … …  
    340282      listout = Addtolistnom(toprinttmp,listout,0); 
    341283   } 
     284   Save_Length(toprinttmp,44); 
    342285   strcpy(toprinttmp,""); 
    343    Save_Length(toprinttmp,44); 
    344286 
    345287   return listout; 
    … …  
    356298/*                                                                            */ 
    357299/******************************************************************************/ 
    358 void DecomposeTheName(char *nom) 
    359 { 
    360    char toprinttmp[LONG_4C]; 
    361    int i; 
     300void DecomposeTheName(const char *nom) 
     301{ 
     302   char toprinttmp[LONG_M]; 
    362303   char chartmp[2]; 
    363  
    364    i=0; 
     304   size_t i = 0; 
     305    
    365306   strcpy(toprinttmp,""); 
    366    /*                                                                         */ 
     307 
    367308   while ( i < strlen(nom) ) 
    368309   { 
    … …  
    390331         strcat(toprinttmp,chartmp); 
    391332      } 
    392       /*                                                                      */ 
    393333      i=i+1; 
    394334   } 
    395    Save_Length(toprinttmp,44); 
    396335   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) 
    397336   { 
    … …  
    400339      IsVarInUseFile(toprinttmp); 
    401340   } 
     341   Save_Length(toprinttmp,44); 
    402342   strcpy(toprinttmp,""); 
    403343 
    404344} 
    405345 
    406 void convert2lower(char *name) 
    407 { 
    408    int l; 
    409    int i; 
    410    int caractere; 
    411  
    412    l=strlen(name)-1; 
    413    for (i=0;i<=l;i++) 
    414    { 
    415       caractere=name[i]; 
    416       if ((caractere>=65 && caractere<=90)||(caractere>=192 && caractere<=221)) 
    417       { 
    418          name[i]+=32; 
    419       } 
    420    } 
    421 } 
    422  
    423 int convert2int(char *name) 
     346void convert2lower(char *lowername, const char* inputname) 
     347{ 
     348    int i, l, caractere; 
     349 
     350    strcpy(lowername, inputname); 
     351    l = strlen(lowername)-1; 
     352 
     353    for ( i=0 ; i<=l ; i++) 
     354    { 
     355        caractere = lowername[i]; 
     356        if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) ) 
     357        { 
     358            lowername[i] += 32; 
     359        } 
     360    } 
     361} 
     362 
     363int convert2int(const char *name) 
    424364{ 
    425365   int i; 

  • vendors/AGRIF/current/LIB/UtilFile.c

    r1901 r4777  
    4040 
    4141/******************************************************************************/ 
    42 /*                            associate                                       */ 
     42/*                         open_for_write                                     */ 
    4343/******************************************************************************/ 
    4444/* This subroutine is used to open a file                                     */ 
    4545/******************************************************************************/ 
    46 FILE * associate (char *filename) 
     46FILE* open_for_write (const char *filename) 
    4747{ 
    48   char filefich[LONG_C]; 
    49   sprintf(filefich,"%s/%s",nomdir,filename); 
    50   return fopen (filefich, "w"); 
     48    char filefich[LONG_FNAME]; 
     49    sprintf(filefich,"%s/%s",include_dir,filename); 
     50    return fopen(filefich, "w"); 
    5151} 
    5252 
    53  
    5453/******************************************************************************/ 
    55 /*                          associateaplus                                    */ 
     54/*                          open_for_append                                   */ 
    5655/******************************************************************************/ 
    5756/* This subroutine is used to open a file with option a+                      */ 
    5857/******************************************************************************/ 
    59 FILE * associateaplus (char *filename) 
     58FILE* open_for_append (const char *filename) 
    6059{ 
    61   char filefich[LONG_C]; 
    62   sprintf(filefich,"%s/%s",nomdir,filename); 
    63   return fopen (filefich, "a+"); 
     60    char filefich[LONG_M]; 
     61    sprintf(filefich,"%s/%s",include_dir,filename); 
     62    return fopen(filefich, "a+"); 
    6463} 
    6564 
    66  
    6765/******************************************************************************/ 
    68 /*                           setposcurname                                       */ 
     66/*                           setposcurname                                    */ 
    6967/******************************************************************************/ 
    7068/* This subroutine is used to know the current position in the file in argument    */ 
    … …  
    7674long int setposcurname(FILE *fileout) 
    7775{ 
    78    fflush(fileout); 
    79    return ftell(fileout); 
     76    fflush(fileout); 
     77    return ftell(fileout); 
    8078} 
    8179 
    … …  
    9189long int setposcur() 
    9290{ 
    93    fflush(fortranout); 
    94    return ftell(fortranout); 
    95 } 
    96  
    97 /******************************************************************************/ 
    98 /*                      setposcurinoldfortranout                              */ 
    99 /******************************************************************************/ 
    100 /* This subroutine is used to know the position in the oldfortranout         */ 
    101 /******************************************************************************/ 
    102 /*                                                                            */ 
    103 /*             setposcurinoldfortranout ---------> position in file           */ 
    104 /*                                                                            */ 
    105 /******************************************************************************/ 
    106 long int setposcurinoldfortranout() 
    107 { 
    108    fflush(oldfortranout); 
    109    return ftell(oldfortranout); 
     91    return setposcurname(fortran_out); 
    11092} 
    11193 
    … …  
    11496/******************************************************************************/ 
    11597/* Firstpass 0                                                                */ 
    116 /* We should write in the fortranout the USE tok_name                         */ 
     98/* We should write in the fortran_out the USE tok_name                         */ 
    11799/* read in the original file                                                  */ 
    118100/******************************************************************************/ 
    119101/*                                                                            */ 
    120102/******************************************************************************/ 
    121 void copyuse_0(char *namemodule) 
     103void copyuse_0(const char *namemodule) 
    122104{ 
    123    if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 ) 
    124    { 
    125       /* We should write this declaration into the original subroutine too    */ 
    126       fprintf(oldfortranout,"      USE %s \n",namemodule); 
    127    } 
     105    if ( IsTabvarsUseInArgument_0() == 1 ) 
     106    { 
     107        /* We should write this declaration into the original subroutine too    */ 
     108        fprintf(oldfortran_out,"      use %s\n", namemodule); 
     109    } 
    128110} 
    129111 
    … …  
    132114/******************************************************************************/ 
    133115/* Firstpass 0                                                                */ 
    134 /* We should write in the fortranout the USE tok_name, only                   */ 
     116/* We should write in the fortran_out the USE tok_name, only                   */ 
    135117/* read in the original file                                                  */ 
    136118/******************************************************************************/ 
    137119/*                                                                            */ 
    138120/******************************************************************************/ 
    139 void copyuseonly_0(char *namemodule) 
     121void copyuseonly_0(const char *namemodule) 
    140122{ 
    141123   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 ) 
    142124   { 
    143125      /* We should write this declaration into the original subroutine too    */ 
    144       fprintf(oldfortranout,"      USE %s , ONLY : \n",namemodule); 
     126      fprintf(oldfortran_out,"      use %s , only : \n", namemodule); 
    145127   } 
    146128} 

  • vendors/AGRIF/current/LIB/UtilFortran.c

    r2671 r4777  
    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                 sprintf(ligne,"TYPE :: Agrif_%s",curmodulename); 
    514                 tofich(module_declar,ligne,1); 
    515                 headtypewritten = 1; 
    516               } 
    517             changeval = 0; 
    518             if (parcours->var->v_allocatable == 1) 
    519              { 
    520                changeval = 1; 
    521                parcours->var->v_allocatable = 0; 
    522                parcours->var->v_pointerdeclare = 1; 
    523              } 
    524             writevardeclaration(parcours,module_declar,0,0); 
    525             if (changeval == 1) 
    526               { 
    527                parcours->var->v_allocatable = 1; 
    528                parcours->var->v_pointerdeclare = 0; 
    529               } 
    530             } 
    531          } 
    532          parcours = parcours -> suiv; 
    533       } 
    534       if (out == 1) 
    535         { 
    536                 sprintf(ligne,"END TYPE Agrif_%s",curmodulename); 
    537                 tofich(module_declar,ligne,1); 
    538                 sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename);  
    539                 tofich(module_declar,ligne,1); 
    540                 sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename);  
    541                 tofich(module_declar,ligne,1); 
    542                 sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename);  
    543                 tofich(module_declar,ligne,1); 
    544         } 
    545    } 
    546 } 
    547  
    548 void Write_NotGridDepend_Declaration_0() 
    549 { 
    550    listvar *parcours; 
    551  
    552    if ( firstpass == 0 ) 
    553    { 
    554       parcours = List_NotGridDepend_Var; 
    555       while( parcours ) 
    556       { 
    557          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    558          { 
    559             writevardeclaration(parcours,fortranout,0,1); 
    560          } 
    561          parcours = parcours -> suiv; 
    562       } 
    563    } 
     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    } 
    564399} 
    565400 
    … …  
    659494      if ( !List_Pointer_Var ) 
    660495      { 
    661          newvar = (listname *)malloc(sizeof(listname)); 
    662          strcpy(newvar->n_name,nom); 
    663          Save_Length(nom,20); 
     496         newvar = (listname*) calloc(1, sizeof(listname)); 
     497         strcpy(newvar->n_name, nom); 
    664498         newvar->suiv = NULL; 
    665499         List_Pointer_Var = newvar; 
    … …  
    681515            { 
    682516               /* add the record                                              */ 
    683               newvar = (listname *)malloc(sizeof(listname)); 
     517              newvar = (listname*) calloc(1, sizeof(listname)); 
    684518              strcpy(newvar->n_name,nom); 
    685               Save_Length(nom,20); 
    686519              newvar->suiv = NULL; 
    687520              parcours->suiv = newvar; 
    … …  
    735568      while( parcours && out == 0 ) 
    736569      { 
    737          if ( !strcasecmp(ident,parcours->var->v_nomvar) )  
     570         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
    738571             { 
    739572             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1; 
    … …  
    747580 
    748581/******************************************************************************/ 
    749 /*                          VariableIsNotFunction                             */ 
    750 /******************************************************************************/ 
    751 /*                                                                            */ 
    752 /******************************************************************************/ 
    753 int VariableIsNotFunction(char *ident) 
    754 { 
    755    int out; 
    756    listvar *newvar; 
    757  
    758    out =0; 
    759  
    760    if ( !strcasecmp(ident,"size") || 
    761         !strcasecmp(ident,"if")   || 
    762         !strcasecmp(ident,"max")  || 
    763         !strcasecmp(ident,"min") 
    764       ) 
    765    { 
    766       newvar = List_SubroutineDeclaration_Var; 
    767       while ( newvar && out == 0 ) 
    768       { 
    769          if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) && 
    770               !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1; 
    771          newvar = newvar -> suiv ; 
    772       } 
    773       if ( out == 1 ) out = 0; 
    774       else out = 1; 
    775       /* if it has not been found                                             */ 
    776       if ( out == 1 ) 
    777       { 
    778          out = 0; 
    779          newvar = List_Global_Var; 
    780          while ( newvar && out == 0 ) 
    781          { 
    782             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            } 
    783606            newvar = newvar -> suiv ; 
    784          } 
    785          if ( out == 1 ) out = 0; 
    786          else out = 1; 
    787       } 
    788    } 
    789    /*                                                                         */ 
    790    return out; 
    791 } 
     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} 

  • vendors/AGRIF/current/LIB/UtilListe.c

    r2671 r4777  
    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    if (InitialValueGiven == 1 ) 
    150    { 
    151       strcpy(curvar->v_initialvalue,InitValue); 
    152       Save_Length(InitValue,14); 
    153    } 
    154    /* Si cette variable est declaree en save                                  */ 
    155    if (SaveDeclare == 1 ) { 
    156    curvar->v_save = 1; 
    157    } 
    158  
    159    /* Si cette variable est v_allocatable                                     */ 
    160    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; 
    161     
    162    /* Si cette variable est v_targer                                     */ 
    163    if (Targetdeclare == 1 ) curvar->v_target=1; 
    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  
     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} 
    172194 
    173195/******************************************************************************/ 
    … …  
    176198/*                                                                            */ 
    177199/******************************************************************************/ 
    178 void duplicatelistvar(listvar *orig) 
    179 { 
    180    listvar *parcours; 
    181    listvar *tmplistvar; 
    182    listvar *tmplistvarprec; 
    183    listdim *tmplistdim; 
    184    variable *tmpvar; 
    185  
    186    tmplistvarprec = (listvar *)NULL; 
    187    parcours = orig; 
    188    while ( parcours ) 
    189    { 
    190       tmplistvar = (listvar *)malloc(sizeof(listvar)); 
    191       tmpvar = (variable *)malloc(sizeof(variable)); 
    192       /*                                                                      */ 
    193       Init_Variable(tmpvar); 
    194       /*                                                                      */ 
    195       strcpy(tmpvar->v_typevar,parcours->var->v_typevar); 
    196       strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar); 
    197       strcpy(tmpvar->v_oldname,parcours->var->v_oldname); 
    198       strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar); 
    199       if ( parcours->var->v_dimension ) 
    200       { 
    201          tmplistdim = (listdim *)malloc(sizeof(listdim)); 
    202          tmplistdim = parcours->var->v_dimension; 
    203          tmpvar->v_dimension = tmplistdim; 
    204       } 
    205       tmpvar->v_nbdim=parcours->var->v_nbdim; 
    206       tmpvar->v_common=parcours->var->v_common; 
    207       tmpvar->v_positioninblock=parcours->var->v_positioninblock; 
    208       tmpvar->v_module=parcours->var->v_module; 
    209       tmpvar->v_save=parcours->var->v_save; 
    210       tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter; 
    211       printf("QLKDF\n"); 
    212       tmpvar->v_indicetabvars=parcours->var->v_indicetabvars; 
    213       strcpy(tmpvar->v_modulename,parcours->var->v_modulename); 
    214       strcpy(tmpvar->v_commonname,parcours->var->v_commonname); 
    215       strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec); 
    216  
    217       strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename); 
    218              
    219       tmpvar->v_pointedvar=parcours->var->v_pointedvar; 
    220       strcpy(tmpvar->v_commoninfile,mainfile); 
    221       Save_Length(mainfile,10); 
    222       strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename); 
    223       tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven; 
    224       tmpvar->v_c_star=parcours->var->v_c_star; 
    225       strcpy(tmpvar->v_precision,parcours->var->v_precision); 
    226       strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue); 
    227       tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare; 
    228       tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare; 
    229       tmpvar->v_allocatable=parcours->var->v_allocatable; 
    230       tmpvar->v_target=parcours->var->v_target; 
    231       strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec); 
    232       tmpvar->v_dimsempty=parcours->var->v_dimsempty; 
    233       strcpy(tmpvar->v_readedlistdimension, 
    234                                           parcours->var->v_readedlistdimension); 
    235       /*                                                                      */ 
    236       tmplistvar->var = tmpvar; 
    237       tmplistvar->suiv = NULL; 
    238       /*                                                                      */ 
    239       if ( !listduplicated ) 
    240       { 
    241          listduplicated = tmplistvar; 
    242          tmplistvarprec = listduplicated; 
    243       } 
    244       else 
    245       { 
    246          tmplistvarprec->suiv = tmplistvar; 
    247          tmplistvarprec = tmplistvar; 
    248       } 
    249       /*                                                                      */ 
    250       parcours = parcours->suiv; 
    251    } 
    252 } 
     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// } 
    253270 
    254271/******************************************************************************/ 
    … …  
    269286   listdim *parcours ; 
    270287 
    271    newdim=(listdim *) malloc (sizeof (listdim)); 
     288   newdim=(listdim *) calloc(1,sizeof(listdim)); 
    272289   newdim->dim=nom; 
    273290   newdim->suiv=NULL; 
    … …  
    306323   while(parcours_var) 
    307324   { 
    308       v=parcours_var->var; 
     325      v = parcours_var->var; 
    309326      strcpy(v->v_dimchar,(lin->dim).last); 
    310       Save_Length((lin->dim).last,5); 
    311327      parcours_var=parcours_var->suiv; 
    312328   } 
    … …  
    315331 
    316332/******************************************************************************/ 
    317 /*                                num_dims                                    */ 
     333/*                              get_num_dims                                  */ 
    318334/******************************************************************************/ 
    319335/* This subroutine is used to know the dimension of a table                   */ 
    320336/******************************************************************************/ 
    321337/*                                                                            */ 
    322 /*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */ 
    323 /*                                                                            */ 
    324 /******************************************************************************/ 
    325 int num_dims(listdim *d) 
    326 { 
    327    listdim *parcours; 
    328    int compteur = 0; 
    329  
    330    parcours = d; 
    331    while(parcours) 
    332    { 
    333      compteur++; 
    334      parcours=parcours->suiv; 
    335    } 
    336    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; 
    337353} 
    338354 
    … …  
    344360/*      struct : variable                                                     */ 
    345361/******************************************************************************/ 
    346 variable * createvar(char *nom,listdim *d) 
    347 { 
    348   variable *var; 
    349   listdim *dims; 
    350   char ligne[LONG_C]; 
    351   char listdimension[LONG_C]; 
    352  
    353    var=(variable *) malloc(sizeof(variable)); 
    354    /*                                                                         */ 
    355    Init_Variable(var); 
    356    /*                                                                         */ 
    357    strcpy(var->v_nomvar,nom); 
    358    Save_Length(nom,4); 
    359    /*                                                                         */ 
    360    strcpy(listdimension,""); 
    361    strcpy(var->v_modulename,curmodulename); 
    362    Save_Length(curmodulename,6); 
    363    strcpy(var->v_commoninfile,mainfile); 
    364    Save_Length(mainfile,10); 
    365    strcpy(var->v_subroutinename,subroutinename); 
    366    Save_Length(subroutinename,11); 
    367    /*                                                                         */ 
    368    if ( strcasecmp(nameinttypename,"") ) 
    369    { 
    370       strcpy(var->v_nameinttypename,nameinttypename); 
    371       Save_Length(nameinttypename,9); 
    372    } 
    373           
    374    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1; 
    375    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1; 
    376    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ; 
    377    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ; 
    378    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1; 
    379    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1; 
    380    /*                                                                         */ 
    381    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; 
    382392 
    383393   /* Creation of the string for the dimension of this variable               */ 
    384    dimsempty = 1; 
    385    if ( d ) 
    386    { 
    387       var->v_dimensiongiven=1; 
    388       dims = d; 
    389       while (dims) 
    390       { 
    391          if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) 
    392                                                                   dimsempty = 0; 
    393          sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); 
    394          strcat(listdimension,ligne); 
    395          if ( dims->suiv ) 
    396          { 
    397             strcat(listdimension,","); 
    398          } 
    399          dims = dims->suiv; 
    400       } 
    401       if ( dimsempty == 1 ) var->v_dimsempty=1; 
    402    } 
    403    strcpy(var->v_readedlistdimension,listdimension); 
    404    Save_Length(listdimension,15); 
    405    /*                                                                         */ 
    406    var->v_nbdim=num_dims(d); 
    407    /*                                                                         */ 
    408    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; 
    409420} 
    410421 
    … …  
    427438   listvar *tmpvar ; 
    428439 
    429    newvar=(listvar *) malloc (sizeof (listvar)); 
     440   newvar=(listvar *) calloc(1,sizeof(listvar)); 
    430441   newvar->var=v; 
    431442   newvar->suiv = NULL; 
    … …  
    460471/*                                                                            */ 
    461472/******************************************************************************/ 
    462 listvar *settype(char *nom,listvar *lin) 
     473listvar *settype(const char *nom, listvar *lin) 
    463474{ 
    464475   listvar *newvar; 
    465476   variable *v; 
    466477 
    467    newvar=lin; 
     478   newvar = lin; 
    468479   while (newvar) 
    469480   { 
    470       v=newvar->var; 
     481      v = newvar->var; 
    471482      strcpy(v->v_typevar,nom); 
    472       Save_Length(nom,3); 
    473       newvar=newvar->suiv; 
    474    } 
    475    newvar=lin; 
     483      v->v_catvar = get_cat_var(v); 
     484      newvar = newvar->suiv; 
     485   } 
     486   newvar = lin; 
    476487   return newvar ; 
    477488} 
    … …  
    505516   variable *v; 
    506517   int out ; 
    507     
     518 
    508519   newvar=lin; 
    509520   out = 0; 
    … …  
    525536   listname *tmpvar; 
    526537 
    527    newvar=(listname *) malloc (sizeof (listname)); 
     538   newvar=(listname *) calloc(1,sizeof(listname)); 
    528539   strcpy(newvar->n_name,nom); 
    529540   newvar->suiv = NULL; 
    … …  
    562573    tmpvar = tmpvar->suiv; 
    563574   } 
    564     
     575 
    565576   tmpvar->suiv = l2; 
    566     
     577 
    567578   return l1; 
    568579} 
    569580 
    570 void *createstringfromlistname(char *ligne, listname *lin) 
    571 { 
    572 listname *tmpvar; 
    573  
    574 strcpy(ligne,""); 
    575 tmpvar = lin; 
    576 while(tmpvar) 
    577 { 
    578   strcat(ligne,tmpvar->n_name); 
    579   if (tmpvar->suiv) strcat(ligne,","); 
    580   tmpvar=tmpvar->suiv; 
    581 } 
     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    } 
    582594} 
    583595 
    … …  
    601613void removeglobfromlist(listname **lin) 
    602614{ 
    603   listname *listemp; 
    604615  listname *parcours1; 
    605616  listvar *parcours2; 
    606617  listname * parcourspres; 
    607618  int out; 
    608    
     619 
    609620  parcours1 = *lin; 
    610621  parcourspres = (listname *)NULL; 
    611    
     622 
    612623  while (parcours1) 
    613624  { 
    … …  
    638649   { 
    639650   parcourspres = parcours1; 
    640     parcours1 = parcours1->suiv;   
     651    parcours1 = parcours1->suiv; 
    641652    } 
    642653  } 
    … …  
    645656void writelistpublic(listname *lin) 
    646657{ 
    647   listname *parcours1; 
    648   char ligne[LONG_40M]; 
    649   char tempname[LONG_4M]; 
    650    
    651   if (lin) 
    652   { 
    653   sprintf(ligne,"public :: "); 
    654   parcours1 = lin; 
    655    
    656   while (parcours1) 
    657   { 
    658     strcat(ligne,parcours1->n_name); 
    659     if (parcours1->suiv) strcat(ligne,", "); 
    660     parcours1 = parcours1->suiv;   
    661   } 
    662   tofich(fortranout,ligne,1); 
    663   } 
    664  
     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    } 
    665674} 
    666675 
    667676void Init_List_Data_Var() 
    668677{ 
    669 listvar *parcours; 
    670  
    671 parcours = List_Data_Var_Cur; 
    672  
    673 if (List_Data_Var_Cur) 
    674 { 
    675 while (parcours) 
    676 { 
    677  List_Data_Var_Cur = List_Data_Var_Cur->suiv; 
    678  free(parcours); 
    679  parcours = List_Data_Var_Cur; 
    680 } 
    681 } 
    682  
    683 List_Data_Var_Cur = NULL; 
    684  
    685 } 
     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} 

  • vendors/AGRIF/current/LIB/UtilNotGridDep.c

    r1901 r4777  
    7171   } 
    7272   /* if variable does not exist, we add it                                   */ 
    73    newvar=(listvar *)malloc(sizeof(listvar)); 
    74    newvar->var=(variable *)malloc(sizeof(variable)); 
     73   newvar=(listvar *)calloc(1,sizeof(listvar)); 
     74   newvar->var=(variable *)calloc(1,sizeof(variable)); 
    7575   strcpy(newvar->var->v_nomvar,name); 
    76    Save_Length(name,4); 
    77    strcpy(newvar->var->v_commoninfile,mainfile); 
    78    Save_Length(mainfile,10); 
     76   strcpy(newvar->var->v_commoninfile,cur_filename); 
    7977   strcpy(newvar->var->v_subroutinename,subroutinename); 
    80    Save_Length(subroutinename,11); 
    8178   newvar->var->v_notgrid = 1 ; 
    8279   newvar->suiv = List_NotGridDepend_Var; 

  • vendors/AGRIF/current/LIB/WorkWithAllocatelist.c

    r1901 r4777  
    4545/*                                                                            */ 
    4646/******************************************************************************/ 
    47 void Add_Allocate_Var_1(char *nom,char *nommodule) 
     47void Add_Allocate_Var_1(const char *nom, const char *nommodule) 
    4848{ 
    4949   listallocate *newvar; 
    … …  
    5555      if ( !List_Allocate_Var ) 
    5656      { 
    57          newvar = (listallocate *)malloc(sizeof(listallocate)); 
     57         newvar = (listallocate *)calloc(1,sizeof(listallocate)); 
    5858         strcpy(newvar->a_nomvar,nom); 
     59         strcpy(newvar->a_subroutine,subroutinename); 
     60         strcpy(newvar->a_module,nommodule); 
    5961         Save_Length(nom,25); 
    60          strcpy(newvar->a_subroutine,subroutinename); 
    61          Save_Length(subroutinename,26); 
    62          strcpy(newvar->a_module,nommodule); 
    63          Save_Length(nommodule,27); 
    6462         newvar->suiv = NULL; 
    6563         List_Allocate_Var = newvar; 
    … …  
    7169         while ( parcours->suiv && out == 0 ) 
    7270         { 
    73             if (  !strcasecmp(parcours->a_nomvar,nom) && 
    74                   !strcasecmp(parcours->a_subroutine,subroutinename) && 
    75                   !strcasecmp(parcours->a_module,nommodule) ) out = 1; 
     71            if (  !strcasecmp(parcours->a_nomvar, nom) && 
     72                  !strcasecmp(parcours->a_subroutine, subroutinename) && 
     73                  !strcasecmp(parcours->a_module, nommodule) ) out = 1; 
    7674            else 
    7775               parcours=parcours->suiv; 
    … …  
    8583            { 
    8684               /* add the record                                              */ 
    87               newvar = (listallocate *)malloc(sizeof(listallocate)); 
    88               strcpy(newvar->a_nomvar,nom); 
     85              newvar = (listallocate *)calloc(1,sizeof(listallocate)); 
     86              strcpy(newvar->a_nomvar, nom); 
     87              strcpy(newvar->a_subroutine, subroutinename); 
     88              strcpy(newvar->a_module, nommodule); 
    8989              Save_Length(nom,25); 
    90               strcpy(newvar->a_subroutine,subroutinename); 
    91               Save_Length(subroutinename,26); 
    92               strcpy(newvar->a_module,nommodule); 
    93               Save_Length(nommodule,27); 
    9490              newvar->suiv = NULL; 
    9591              parcours->suiv = newvar; 
    … …  
    108104/*                                                                            */ 
    109105/******************************************************************************/ 
    110 int IsVarAllocatable_0(char *ident) 
    111 { 
    112    listallocate *parcours; 
    113    int out; 
    114  
    115    out = 0 ; 
    116    if ( firstpass == 0 ) 
    117    { 
    118       parcours = List_Allocate_Var; 
    119       while ( parcours && out == 0 ) 
    120       { 
    121          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ; 
    122          else parcours=parcours->suiv; 
    123       } 
    124    } 
    125    return out; 
    126 } 
    127  
    128  
    129 /******************************************************************************/ 
    130 /*                          varisallocatable_0                                */ 
    131 /******************************************************************************/ 
    132 /* Firstpass 0                                                                */ 
    133 /******************************************************************************/ 
    134 /*                                                                            */ 
    135 /******************************************************************************/ 
    136 int varisallocatable_0(char *ident) 
    137 { 
    138    listallocate *newvaralloc; 
    139    int out; 
    140  
    141    out =0; 
    142    if (firstpass == 0 ) 
    143    { 
    144          newvaralloc = List_Allocate_Var; 
    145          while ( newvaralloc && out == 0 ) 
    146          { 
    147             if ( !strcasecmp(ident,newvaralloc->a_nomvar) )  out = 1; 
    148             else newvaralloc = newvaralloc->suiv; 
    149          } 
    150    } 
    151    return out; 
    152 } 
     106// int IsVarAllocatable_0(const char *ident) 
     107// { 
     108//    listallocate *parcours; 
     109//    int out; 
     110//  
     111//    out = 0 ; 
     112//    if ( firstpass == 0 ) 
     113//    { 
     114//       parcours = List_Allocate_Var; 
     115//       while ( parcours && out == 0 ) 
     116//       { 
     117//          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ; 
     118//          else parcours=parcours->suiv; 
     119//       } 
     120//    } 
     121//    return out; 
     122// } 

  • vendors/AGRIF/current/LIB/WorkWithParameterlist.c

    r2671 r4777  
    4747void Add_GlobalParameter_Var_1(listvar *listin) 
    4848{ 
    49    if ( firstpass == 1 ) 
    50    { 
    51       if ( VariableIsParameter == 1 ) { 
    52       List_GlobalParameter_Var =  AddListvarToListvar(listin,List_GlobalParameter_Var,1); 
    53       } 
    54    } 
     49    if ( VariableIsParameter ) 
     50        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1); 
    5551} 
    5652 
    … …  
    6460void Add_Parameter_Var_1(listvar *listin) 
    6561{ 
    66    listvar *parcours; 
     62    listvar *parcours; 
    6763 
    68    if ( firstpass == 1 && VariableIsParameter == 1 ) 
    69    { 
    70       if ( !List_Parameter_Var ) 
    71       { 
    72          List_Parameter_Var = listin; 
    73       } 
    74       else 
    75       { 
    76          parcours = List_Parameter_Var; 
    77          while (parcours->suiv) parcours=parcours->suiv; 
    78          parcours->suiv = listin; 
    79       } 
    80    } 
     64    if ( !VariableIsParameter )    return; 
     65 
     66    if ( List_Parameter_Var == NULL ) 
     67    { 
     68        List_Parameter_Var = listin; 
     69    } 
     70    else 
     71    { 
     72        parcours = List_Parameter_Var; 
     73        while ( parcours->suiv ) 
     74            parcours = parcours->suiv; 
     75        parcours->suiv = listin; 
     76    } 
    8177} 
    8278 
    … …  
    9288   listvar *parcours; 
    9389 
    94    if ( firstpass == 1 ) 
    95    { 
    96       if ( !List_Dimension_Var ) 
    97       { 
    98          List_Dimension_Var = listin; 
    99       } 
    100       else 
    101       { 
    102          parcours = List_Dimension_Var; 
    103          while (parcours->suiv) parcours=parcours->suiv; 
    104          parcours->suiv = listin; 
    105       } 
    106    } 
     90    if ( List_Dimension_Var == NULL ) 
     91    { 
     92        List_Dimension_Var = listin; 
     93    } 
     94    else 
     95    { 
     96        parcours = List_Dimension_Var; 
     97        while (parcours->suiv) 
     98            parcours = parcours->suiv; 
     99        parcours->suiv = listin; 
     100    } 
    107101} 

  • vendors/AGRIF/current/LIB/WorkWithglobliste.c

    r1901 r4777  
    4646void Add_Globliste_1(listvar *listtoadd) 
    4747{ 
    48    if ( firstpass == 1 ) 
    49    { 
    50       if ( aftercontainsdeclare == 0 && 
    51            VariableIsParameter  == 0 ) 
    52       { 
    53          List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1); 
    54       } 
    55    } 
     48    if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 ) 
     49    { 
     50        List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1); 
     51    } 
    5652} 
    5753 
    … …  
    10096   { 
    10197    strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last); 
    102     strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);     
     98    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first); 
    10399   } 
    104100   out = 1; 

  • vendors/AGRIF/current/LIB/WorkWithlistdatavariable.c

    r2671 r4777  
    5151{ 
    5252  listvar *newvar; 
    53   char ligne[LONG_C]; 
     53  char ligne[LONG_M]; 
    5454 
    5555//  if ( firstpass == 1 ) 
    5656//  { 
    57      newvar=(listvar *)malloc(sizeof(listvar)); 
    58      newvar->var=(variable *)malloc(sizeof(variable)); 
     57     newvar=(listvar *)calloc(1,sizeof(listvar)); 
     58     newvar->var=(variable *)calloc(1,sizeof(variable)); 
    5959     /*                                                                       */ 
    6060     Init_Variable(newvar->var); 
    … …  
    6262     if ( inmoduledeclare == 1 ) newvar->var->v_module=1; 
    6363     strcpy(newvar->var->v_nomvar,name); 
    64      Save_Length(name,4); 
    6564     strcpy(newvar->var->v_subroutinename,subroutinename); 
    66      Save_Length(subroutinename,11); 
    6765     strcpy(newvar->var->v_modulename,curmodulename); 
    68      Save_Length(curmodulename,6); 
    69      strcpy(newvar->var->v_commoninfile,mainfile); 
    70      Save_Length(mainfile,10); 
     66     strcpy(newvar->var->v_commoninfile,cur_filename); 
    7167     if (strchr(values,',') && strncasecmp(values,"'",1)) 
    72             { 
    73             sprintf(ligne,"(/%s/)",values); 
    74             } 
     68        sprintf(ligne,"(/%s/)",values); 
    7569     else 
    76        strcpy(ligne,values); 
     70        strcpy(ligne,values); 
    7771        
    7872     strcpy(newvar->var->v_initialvalue,ligne); 
    … …  
    9387void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2) 
    9488{ 
    95   listvar *newvar; 
    96   listvar *tmpvar; 
    97   listname *tmpvar1; 
    98   listname *tmpvar2;   
    99   char ligne[LONG_C]; 
     89    listvar *newvar; 
     90    listvar *tmpvar; 
     91    listname *tmpvar1; 
     92    listname *tmpvar2;   
     93    variable *found_var = NULL; 
     94     
     95    tmpvar1 = l1; 
     96    tmpvar2 = l2; 
    10097   
    101   tmpvar1 = l1; 
    102   tmpvar2 = l2; 
    103    
    104   while (tmpvar1) 
    105   { 
    106      newvar=(listvar *)malloc(sizeof(listvar)); 
    107      newvar->var=(variable *)malloc(sizeof(variable)); 
    108      /*                                                                       */ 
    109      Init_Variable(newvar->var); 
    110      /*                                                                       */ 
    111      if ( inmoduledeclare == 1 ) newvar->var->v_module=1; 
    112      strcpy(newvar->var->v_nomvar,tmpvar1->n_name); 
    113      Save_Length(tmpvar1->n_name,4); 
    114      strcpy(newvar->var->v_subroutinename,subroutinename); 
    115      Save_Length(subroutinename,11); 
    116      strcpy(newvar->var->v_modulename,curmodulename); 
    117      Save_Length(curmodulename,6); 
    118      strcpy(newvar->var->v_commoninfile,mainfile); 
    119      Save_Length(mainfile,10); 
    120         
    121      strcpy(newvar->var->v_initialvalue,tmpvar2->n_name); 
    122      Save_Length(tmpvar2->n_name,14); 
    123      newvar->suiv = NULL; 
     98    while (tmpvar1) 
     99    { 
     100        newvar = (listvar *) calloc(1,sizeof(listvar)); 
     101        newvar->var = (variable *) calloc(1,sizeof(variable)); 
     102 
     103        Init_Variable(newvar->var); 
     104 
     105        if ( inmoduledeclare == 1 ) newvar->var->v_module=1; 
    124106      
    125      if ( ! (*curlist) ) 
    126      { 
    127         *curlist  = newvar ; 
    128      } 
    129      else 
    130      { 
    131         tmpvar = *curlist; 
    132         while (tmpvar->suiv) 
    133           tmpvar=tmpvar->suiv; 
    134         tmpvar->suiv = newvar; 
    135      } 
     107        found_var = get_variable_in_list_from_name(List_Common_Var, tmpvar1->n_name); 
     108        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_Global_Var,tmpvar1->n_name); 
     109        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tmpvar1->n_name); 
     110         
     111        if ( found_var && found_var->v_nbdim > 0 ) 
     112        { 
     113            printf("##############################################################################################################\n"); 
     114            printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n"); 
     115            printf("##   variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename, 
     116                                                              found_var->v_subroutinename, found_var->v_commonname); 
     117            exit(1); 
     118        } 
     119         
     120        strcpy(newvar->var->v_nomvar,tmpvar1->n_name); 
     121        strcpy(newvar->var->v_subroutinename,subroutinename); 
     122        strcpy(newvar->var->v_modulename,curmodulename); 
     123        strcpy(newvar->var->v_commoninfile,cur_filename); 
     124        strcpy(newvar->var->v_initialvalue,tmpvar2->n_name); 
     125 
     126        Save_Length(tmpvar2->n_name,14); 
     127 
     128        newvar->suiv = NULL; 
    136129      
    137   tmpvar1 = tmpvar1->suiv; 
    138   tmpvar2 = tmpvar2->suiv;   
    139   } 
    140   return; 
    141  
    142  
     130        if ( *curlist != NULL ) 
     131        { 
     132            tmpvar = *curlist; 
     133            while (tmpvar->suiv) 
     134                tmpvar = tmpvar->suiv; 
     135            tmpvar->suiv = newvar; 
     136        } 
     137        else 
     138        { 
     139            *curlist  = newvar ; 
     140        } 
     141      
     142        tmpvar1 = tmpvar1->suiv; 
     143        tmpvar2 = tmpvar2->suiv;   
     144    } 
    143145} 

  • vendors/AGRIF/current/LIB/WorkWithlistmoduleinfile.c

    r1901 r4777  
    3838#include "decl.h" 
    3939 
    40 void Save_Length(char *nom, int whichone) 
     40void Save_Length(const char *nom, int whichone) 
    4141{ 
    42    if ( whichone == 1  && strlen(nom) > length_last ) 
     42    size_t len_nom = strlen(nom); 
     43     
     44   if ( whichone == 1  && len_nom > length_last ) 
    4345   { 
    44       length_last               = strlen(nom); 
    45       if ( length_last > LONG_C ) 
    46       { 
    47          printf("WARNING 1 : The value of LONG_C - define in decl.h -\n"); 
    48          printf("             should be upgrated to %d\n",length_last+100); 
    49       } 
     46      length_last = len_nom; 
     47      if ( length_last > LONG_M ) 
     48            printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100); 
    5049   } 
    51    if ( whichone == 2  && strlen(nom) > length_first ) 
     50   if ( whichone == 2  && len_nom > length_first ) 
    5251   { 
    53       length_first              = strlen(nom); 
    54       if ( length_first > LONG_C ) 
    55       { 
    56          printf("WARNING 2 : The value of LONG_C - define in decl.h -\n"); 
    57          printf("             should be upgrated to %d\n",length_first+100); 
    58       } 
     52      length_first = len_nom; 
     53      if ( length_first > LONG_M ) 
     54           printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100); 
    5955   } 
    60    if ( whichone == 3  && strlen(nom) > length_v_typevar ) 
     56   if ( whichone == 8  && len_nom > length_v_vallengspec ) 
    6157   { 
    62       length_v_typevar          = strlen(nom); 
    63       if ( length_v_typevar > LONG_C ) 
    64       { 
    65          printf("WARNING 3 : The value of LONG_C - define in decl.h -\n"); 
    66          printf("             should be upgrated to %d\n",length_v_typevar+100); 
    67       } 
     58      length_v_vallengspec = len_nom; 
     59      if ( length_v_vallengspec > LONG_M ) 
     60           printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100); 
    6861   } 
    69    if ( whichone == 4  && strlen(nom) > length_v_nomvar ) 
     62   if ( whichone == 12 && len_nom > length_v_precision ) 
    7063   { 
    71       length_v_nomvar           = strlen(nom); 
    72       if ( length_v_nomvar > LONG_C ) 
    73       { 
    74          printf("WARNING 4 : The value of LONG_C - define in decl.h -\n"); 
    75          printf("             should be upgrated to %d\n",length_v_nomvar+100); 
    76       } 
     64      length_v_precision = len_nom; 
     65      if ( length_v_precision > LONG_M ) 
     66           printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100); 
    7767   } 
    78    if ( whichone == 5  && strlen(nom) > length_v_dimchar ) 
     68   if ( whichone == 13 && len_nom > length_v_IntentSpec ) 
    7969   { 
    80       length_v_dimchar          = strlen(nom); 
    81       if ( length_v_dimchar > LONG_C ) 
    82       { 
    83          printf("WARNING 5 : The value of LONG_C - define in decl.h -\n"); 
    84          printf("             should be upgrated to %d\n", 
    85                                                           length_v_dimchar+100); 
    86       } 
     70      length_v_IntentSpec = len_nom; 
     71      if ( length_v_IntentSpec > LONG_M ) 
     72           printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100); 
    8773   } 
    88    if ( whichone == 6  && strlen(nom) > length_v_modulename ) 
     74   if ( whichone == 14 && len_nom > length_v_initialvalue ) 
    8975   { 
    90       length_v_modulename       = strlen(nom); 
    91       if ( length_v_modulename > LONG_C ) 
    92       { 
    93          printf("WARNING 6 : The value of LONG_C - define in decl.h -\n"); 
    94          printf("             should be upgrated to %d\n", 
    95                                                        length_v_modulename+100); 
    96       } 
     76      length_v_initialvalue = len_nom; 
     77      if ( length_v_initialvalue > LONG_M ) 
     78           printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100); 
    9779   } 
    98    if ( whichone == 7  && strlen(nom) > length_v_commonname ) 
     80   if ( whichone == 15 && len_nom > length_v_readedlistdimension ) 
    9981   { 
    100       length_v_commonname       = strlen(nom); 
    101       if ( length_v_commonname > LONG_C ) 
    102       { 
    103          printf("WARNING 7 : The value of LONG_C - define in decl.h -\n"); 
    104          printf("             should be upgrated to %d\n", 
    105                                                        length_v_commonname+100); 
    106       } 
     82      length_v_readedlistdimension = len_nom; 
     83      if ( length_v_readedlistdimension > LONG_M ) 
     84           printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100); 
    10785   } 
    108    if ( whichone == 8  && strlen(nom) > length_v_vallengspec ) 
     86   if ( whichone == 25 && len_nom > length_a_nomvar ) 
    10987   { 
    110       length_v_vallengspec      = strlen(nom); 
    111       if ( length_v_vallengspec > LONG_C ) 
    112       { 
    113          printf("WARNING 8 : The value of LONG_C - define in decl.h -\n"); 
    114          printf("             should be upgrated to %d\n", 
    115                                                       length_v_vallengspec+100); 
    116       } 
     88      length_a_nomvar = len_nom; 
     89      if ( length_a_nomvar > LONG_C ) 
     90           printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100); 
    11791   } 
    118    if ( whichone == 9  && strlen(nom) > length_v_nameinttypename ) 
     92   if ( whichone == 39 && len_nom > length_toprintglob ) 
    11993   { 
    120       length_v_nameinttypename  = strlen(nom); 
    121       if ( length_v_nameinttypename > LONG_C ) 
    122       { 
    123          printf("WARNING 9 : The value of LONG_C - define in decl.h -\n"); 
    124          printf("             should be upgrated to %d\n", 
    125                                                   length_v_nameinttypename+100); 
    126       } 
     94      length_toprintglob = len_nom; 
     95      if ( length_toprintglob > LONG_M ) 
     96           printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100); 
    12797   } 
    128    if ( whichone == 10 && strlen(nom) > length_v_commoninfile ) 
     98   if ( whichone == 40 && len_nom > length_tmpvargridname ) 
    12999   { 
    130       length_v_commoninfile     = strlen(nom); 
    131       if ( length_v_commoninfile > LONG_C ) 
    132       { 
    133          printf("WARNING 10 : The value of LONG_C - define in decl.h -\n"); 
    134          printf("             should be upgrated to %d\n", 
    135                                                      length_v_commoninfile+100); 
    136       } 
     100      length_tmpvargridname = len_nom; 
     101      if ( length_tmpvargridname > LONG_M ) 
     102           printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100); 
    137103   } 
    138    if ( whichone == 11 && strlen(nom) > length_v_subroutinename ) 
     104   if ( whichone == 41 && len_nom > length_ligne_Subloop ) 
    139105   { 
    140       length_v_subroutinename   = strlen(nom); 
    141       if ( length_v_subroutinename > LONG_C ) 
    142       { 
    143          printf("WARNING 11 : The value of LONG_C - define in decl.h -\n"); 
    144          printf("             should be upgrated to %d\n", 
    145                                                    length_v_subroutinename+100); 
    146       } 
     106       length_ligne_Subloop = len_nom; 
     107      if ( length_ligne_Subloop > LONG_M ) 
     108           printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100); 
    147109   } 
    148    if ( whichone == 12 && strlen(nom) > length_v_precision ) 
     110   if ( whichone == 43 && len_nom > length_toprint_utilagrif ) 
    149111   { 
    150       length_v_precision        = strlen(nom); 
    151       if ( length_v_precision > LONG_C ) 
    152       { 
    153          printf("WARNING 12 : The value of LONG_C - define in decl.h -\n"); 
    154          printf("             should be upgrated to %d\n", 
    155                                                         length_v_precision+100); 
    156       } 
     112      length_toprint_utilagrif = len_nom; 
     113      if ( length_toprint_utilagrif > LONG_M )