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 5656 for trunk/NEMOGCM/EXTERNAL – NEMO

Ignore:
Timestamp:
2015-07-31T10:55:56+02:00 (9 years ago)
Author:
timgraham
Message:

Merge of AGRIF branch (branches/2014/dev_r4765_CNRS_agrif) onto the trunk

Location:
trunk/NEMOGCM/EXTERNAL/AGRIF
Files:
27 deleted
26 edited
22 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c

    r2715 r5656  
    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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile

    r5440 r5656  
    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 ../$@ 
     21#main.c: convert.y convert.lex 
     22#  @echo =================================================== 
     23#  @echo   Rebuilding main.c ... 
     24#  @echo =================================================== 
     25#  $(MAKE) -f Makefile.lex main.c 
     26 
     27#fortran.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    

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c

    r4147 r5656  
    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");    
     79      WriteIncludeDeclaration(fortran_out); 
     80      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     81      WriteLocalParamDeclaration(fortran_out); 
    10582      WriteArgumentDeclaration_beforecall(); 
    106       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n"); 
    107       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 
    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; 
    155             } 
     122      } 
    156123      parcours = parcours -> suiv; 
    157124   } 
    … …  
    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; 
    169             } 
     133      } 
    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; 
    306             } 
     251      } 
    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); 
     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); 
    407333      WriteArgumentDeclaration_beforecall(); 
    408       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
     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(); 
     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); 
    464381      WriteArgumentDeclaration_beforecall(); 
    465       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
    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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c

    r5573 r5656  
    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        { 
    416         if( strcasecmp(subroutinename,"Agrif_InvLoc") )    
    417        fprintf(fileout,"\n      USE Agrif_Util \n"); 
    418        else fprintf(fileout,"\n      USE Agrif_Types \n"); 
    419  
    420        } 
     276        fprintf(fileout,"\n      use Agrif_Util\n"); 
     277     else 
     278        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n"); 
    421279  } 
    422280} 
    … …  
    424282void  AddUseAgrifUtilBeforeCall_0(FILE *fileout) 
    425283{ 
    426   listusemodule *parcours; 
    427  
    428   int out; 
    429  
    430   if ( firstpass == 0 ) 
    431   { 
    432      parcours = List_NameOfModuleUsed; 
    433      out = 0 ; 
    434      while ( parcours && out == 0 ) 
    435      { 
    436         if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     && 
    437              !strcasecmp(parcours->u_modulename,curmodulename)   && 
    438              !strcasecmp(parcours->u_cursubroutine,subroutinename) 
    439             ) out = 1; 
    440         else parcours = parcours->suiv; 
    441      } 
    442      if ( out == 0 ) 
    443      { 
    444        if( strcasecmp(subroutinename,"Agrif_InitWorkspace") )    
    445        fprintf(fileout,"\n      USE Agrif_Util \n"); 
    446        else fprintf(fileout,"\n      USE Agrif_Types \n"); 
    447      } 
    448   } 
     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    } 
    449306} 
    450307 
    … …  
    458315/*                                                                            */ 
    459316/******************************************************************************/ 
    460 void NotifyAgrifFunction_0(char *ident) 
    461 { 
    462    if ( firstpass == 0 ) 
    463    { 
    464       if ( !strcasecmp(ident,"Agrif_parent") ) 
    465       { 
    466          InAgrifParentDef = 1; 
    467          pos_curagrifparent = setposcur()-12; 
    468       } 
    469       else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 
    470       { 
    471          InAgrifParentDef = 2; 
    472          pos_curagrifparent = setposcur()-21; 
    473       } 
    474       else if ( !strcasecmp(ident,"Agrif_Rhox") ) 
    475       { 
    476          InAgrifParentDef = 3; 
    477          pos_curagrifparent = setposcur()-10; 
    478       } 
    479       else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 
    480       { 
    481          InAgrifParentDef = 4; 
    482          pos_curagrifparent = setposcur()-17; 
    483       } 
    484       else if ( !strcasecmp(ident,"Agrif_IRhox") ) 
    485       { 
    486          InAgrifParentDef = 5; 
    487          pos_curagrifparent = setposcur()-11; 
    488       } 
    489       else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 
    490       { 
    491          InAgrifParentDef = 6; 
    492          pos_curagrifparent = setposcur()-18; 
    493       } 
    494       else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 
    495       { 
    496          InAgrifParentDef = 7; 
    497          pos_curagrifparent = setposcur()-10; 
    498       } 
    499       else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 
    500       { 
    501          InAgrifParentDef = 8; 
    502          pos_curagrifparent = setposcur()-17; 
    503       } 
    504       else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 
    505       { 
    506          InAgrifParentDef = 9; 
    507          pos_curagrifparent = setposcur()-11; 
    508       } 
    509       else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 
    510       { 
    511          InAgrifParentDef = 10; 
    512          pos_curagrifparent = setposcur()-18; 
    513       } 
    514       else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 
    515       { 
    516          InAgrifParentDef = 11; 
    517          pos_curagrifparent = setposcur()-10; 
    518       } 
    519       else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 
    520       { 
    521          InAgrifParentDef = 12; 
    522          pos_curagrifparent = setposcur()-17; 
    523       } 
    524       else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 
    525       { 
    526          InAgrifParentDef = 13; 
    527          pos_curagrifparent = setposcur()-11; 
    528       } 
    529       else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 
    530       { 
    531          InAgrifParentDef = 14; 
    532          pos_curagrifparent = setposcur()-18; 
    533       } 
    534       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 
    535       { 
    536          InAgrifParentDef = 15; 
    537          pos_curagrifparent = setposcur()-23; 
    538       } 
    539       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 
    540       { 
    541          InAgrifParentDef = 16; 
    542          pos_curagrifparent = setposcur()-23; 
    543       } 
    544       else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 
    545       { 
    546          InAgrifParentDef = 17; 
    547          pos_curagrifparent = setposcur()-23; 
    548       } 
    549       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 
    550       { 
    551          InAgrifParentDef = 18; 
    552          pos_curagrifparent = setposcur()-26; 
    553       } 
    554       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 
    555       { 
    556          InAgrifParentDef = 19; 
    557          pos_curagrifparent = setposcur()-26; 
    558       } 
    559       else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 
    560       { 
    561          InAgrifParentDef = 20; 
    562          pos_curagrifparent = setposcur()-26; 
    563       } 
    564       else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 
    565       { 
    566          InAgrifParentDef = 21; 
    567          pos_curagrifparent = setposcur()-19; 
    568       } 
    569       else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 
    570       { 
    571          InAgrifParentDef = 22; 
    572          pos_curagrifparent = setposcur()-17; 
    573       } 
    574       else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 
    575       { 
    576          InAgrifParentDef = 23; 
    577          pos_curagrifparent = setposcur()-15; 
    578       } 
    579       else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 
    580       { 
    581          InAgrifParentDef = 24; 
    582          pos_curagrifparent = setposcur()-15; 
    583       } 
    584       else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 
    585       { 
    586          InAgrifParentDef = 25; 
    587          pos_curagrifparent = setposcur()-15; 
    588       } 
    589       else if ( !strcasecmp(ident,"Agrif_Iz") ) 
    590       { 
    591          InAgrifParentDef = 26; 
    592          pos_curagrifparent = setposcur()-8; 
    593       } 
    594       else if ( !strcasecmp(ident,"Agrif_Iy") ) 
    595       { 
    596          InAgrifParentDef = 27; 
    597          pos_curagrifparent = setposcur()-8; 
    598       } 
    599       else if ( !strcasecmp(ident,"Agrif_Ix") ) 
    600       { 
    601          InAgrifParentDef = 28; 
    602          pos_curagrifparent = setposcur()-8; 
    603       } 
    604       else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 
    605       { 
    606          InAgrifParentDef = 29; 
    607          pos_curagrifparent = setposcur()-20; 
    608       } 
    609       else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 
    610       { 
    611          InAgrifParentDef = 29; 
    612          pos_curagrifparent = setposcur()-19; 
    613       } 
    614       else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 
    615       { 
    616          InAgrifParentDef = 30; 
    617          pos_curagrifparent = setposcur()-13; 
    618       } 
    619    } 
     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    } 
    620476} 
    621477 
    … …  
    629485/*                                                                            */ 
    630486/******************************************************************************/ 
    631 void ModifyTheAgrifFunction_0(char *ident) 
     487void ModifyTheAgrifFunction_0(const char *ident) 
    632488{ 
    633489   if ( InAgrifParentDef != 0 ) 
    634490          AgriffunctionModify_0(ident,InAgrifParentDef); 
    635    /*                                                                         */ 
    636491   InAgrifParentDef = 0; 
    637492} 
    … …  
    707562/*                                                                            */ 
    708563/******************************************************************************/ 
    709 void AgriffunctionModify_0(char *ident,int whichone) 
    710 { 
    711    char toprint[LONG_C]; 
    712    if ( firstpass == 0 ) 
    713    { 
    714       strcpy(toprint,""); 
    715       pos_end = setposcur(); 
    716       fseek(fortranout,pos_curagrifparent,SEEK_SET); 
    717       if ( whichone == 1 || whichone == 2 ) 
    718       { 
    719          /*                                                                   */ 
    720          FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 
    721          if ( !strcasecmp(ident,toprint) ) 
    722          { 
    723             /* la liste des use de cette subroutine                           */ 
    724             strcpy(toprint,""); 
    725             FindAndChangeNameToTabvars(ident, 
    726                                           toprint,List_Common_Var,whichone); 
    727          } 
    728          if ( !strcasecmp(ident,toprint) ) 
    729          { 
    730             /* la liste des use de cette subroutine                           */ 
    731             strcpy(toprint,""); 
    732             FindAndChangeNameToTabvars(ident, 
    733                                           toprint,List_ModuleUsed_Var,whichone); 
    734          } 
    735       } 
    736       else if ( whichone == 3 ) /* Agrif_Rhox                                 */ 
    737       { 
    738          sprintf(toprint,"REAL("); 
    739          if( retour77 == 0 ) strcat(toprint," & \n"); 
    740          else strcat(toprint,"\n     & "); 
    741          strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 
    742       } 
    743       else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */ 
    744       { 
    745          sprintf(toprint,"REAL("); 
    746          if( retour77 == 0 ) strcat(toprint," & \n"); 
    747          else strcat(toprint,"\n     & "); 
    748          strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 
    749       } 
    750       else if ( whichone == 5 ) /* Agrif_Rhox                                 */ 
    751       { 
    752          sprintf(toprint,"Agrif_Curgrid"); 
    753          if( retour77 == 0 ) strcat(toprint," & \n"); 
    754          else strcat(toprint,"\n     & "); 
    755          strcat(toprint,"% spaceref(1)"); 
    756       } 
    757       else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */ 
    758       { 
    759          sprintf(toprint,"Agrif_Curgrid"); 
    760          if( retour77 == 0 ) strcat(toprint," & \n"); 
    761          else strcat(toprint,"\n     & "); 
    762          strcat(toprint,"% parent % spaceref(1)"); 
    763       } 
    764       else if ( whichone == 7 ) /* Agrif_Rhoy                                 */ 
    765       { 
    766          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    767          if( retour77 == 0 ) strcat(toprint," & \n"); 
    768          else strcat(toprint,"\n     & "); 
    769          strcat(toprint,"% spaceref(2))"); 
    770       } 
    771       else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */ 
    772       { 
    773          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    774          if( retour77 == 0 ) strcat(toprint," & \n"); 
    775          else strcat(toprint,"\n     & "); 
    776          strcat(toprint,"% parent % spaceref(2))"); 
    777       } 
    778       else if ( whichone == 9 ) /* Agrif_Rhoy                                 */ 
    779       { 
    780          sprintf(toprint,"Agrif_Curgrid"); 
    781          if( retour77 == 0 ) strcat(toprint," & \n"); 
    782          else strcat(toprint,"\n     & "); 
    783          strcat(toprint,"% spaceref(2)"); 
    784       } 
    785       else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */ 
    786       { 
    787          sprintf(toprint,"Agrif_Curgrid"); 
    788          if( retour77 == 0 ) strcat(toprint," & \n"); 
    789          else strcat(toprint,"\n     & "); 
    790          strcat(toprint,"% parent % spaceref(2)"); 
    791       } 
    792       else if ( whichone == 11 ) /* Agrif_Rhoz                                */ 
    793       { 
    794          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    795          if( retour77 == 0 ) strcat(toprint," & \n"); 
    796          else strcat(toprint,"\n     & "); 
    797          strcat(toprint,"% spaceref(3))"); 
    798       } 
    799       else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */ 
    800       { 
    801          sprintf(toprint,"REAL(Agrif_Curgrid"); 
    802          if( retour77 == 0 ) strcat(toprint," & \n"); 
    803          else strcat(toprint,"\n     & "); 
    804          strcat(toprint,"% parent % spaceref(3))"); 
    805       } 
    806       else if ( whichone == 13 ) /* Agrif_Rhoz                                */ 
    807       { 
    808          sprintf(toprint,"Agrif_Curgrid"); 
    809          if( retour77 == 0 ) strcat(toprint," & \n"); 
    810          else strcat(toprint,"\n     & "); 
    811          strcat(toprint,"% spaceref(3)"); 
    812       } 
    813       else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */ 
    814       { 
    815          sprintf(toprint,"Agrif_Curgrid"); 
    816          if( retour77 == 0 ) strcat(toprint," & \n"); 
    817          else strcat(toprint,"\n     & "); 
    818          strcat(toprint,"% parent % spaceref(3)"); 
    819       } 
    820       else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */ 
    821       { 
    822          sprintf(toprint,"Agrif_Curgrid"); 
    823          if( retour77 == 0 ) strcat(toprint," & \n"); 
    824          else strcat(toprint,"\n     & "); 
    825          strcat(toprint,"% NearRootBorder(1)"); 
    826       } 
    827       else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */ 
    828       { 
    829          sprintf(toprint,"Agrif_Curgrid"); 
    830          if( retour77 == 0 ) strcat(toprint," & \n"); 
    831          else strcat(toprint,"\n     & "); 
    832          strcat(toprint,"% NearRootBorder(2)"); 
    833       } 
    834       else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */ 
    835       { 
    836          sprintf(toprint,"Agrif_Curgrid"); 
    837          if( retour77 == 0 ) strcat(toprint," & \n"); 
    838          else strcat(toprint,"\n     & "); 
    839          strcat(toprint,"% NearRootBorder(3)"); 
    840       } 
    841       else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */ 
    842       { 
    843          sprintf(toprint,"Agrif_Curgrid"); 
    844          if( retour77 == 0 ) strcat(toprint," & \n"); 
    845          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     & "); 
    846698         strcat(toprint,"% DistantRootBorder(1)"); 
    847       } 
    848       else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */ 
    849       { 
    850          sprintf(toprint,"Agrif_Curgrid"); 
    851          if( retour77 == 0 ) strcat(toprint," & \n"); 
    852          else strcat(toprint,"\n     & "); 
    853          strcat(toprint,"% DistantRootBorder(2)"); 
    854       } 
    855       else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */ 
    856       { 
    857          sprintf(toprint,"Agrif_Curgrid"); 
    858          if( retour77 == 0 ) strcat(toprint," & \n"); 
    859          else strcat(toprint,"\n     & "); 
    860          strcat(toprint,"% DistantRootBorder(3)"); 
    861       } 
    862       else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */ 
    863       { 
    864          sprintf(toprint,"Agrif_Curgrid"); 
    865          if( retour77 == 0 ) strcat(toprint," & \n"); 
    866          else strcat(toprint,"\n     & "); 
    867          strcat(toprint,"% parent % grid_id"); 
    868       } 
    869       else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */ 
    870       { 
    871          sprintf(toprint,"Agrif_Curgrid"); 
    872          if( retour77 == 0 ) strcat(toprint," & \n"); 
    873          else strcat(toprint,"\n     & "); 
    874          strcat(toprint,"% grid_id"); 
    875       } 
    876       else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */ 
    877       { 
    878          sprintf(toprint,"Agrif_Curgrid"); 
    879          if( retour77 == 0 ) strcat(toprint," & \n"); 
    880          else strcat(toprint,"\n     & "); 
    881          strcat(toprint,"% parent % ix(3)"); 
    882       } 
    883       else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */ 
    884       { 
    885          sprintf(toprint,"Agrif_Curgrid"); 
    886          if( retour77 == 0 ) strcat(toprint," & \n"); 
    887          else strcat(toprint,"\n     & "); 
    888          strcat(toprint,"% parent % ix(2)"); 
    889       } 
    890       else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */ 
    891       { 
    892          sprintf(toprint,"Agrif_Curgrid"); 
    893          if( retour77 == 0 ) strcat(toprint," & \n"); 
    894          else strcat(toprint,"\n     & "); 
    895          strcat(toprint,"% parent % ix(1)"); 
    896       } 
    897       else if ( whichone == 26 ) /* Agrif_Iz                                  */ 
    898       { 
    899          sprintf(toprint,"Agrif_Curgrid"); 
    900          if( retour77 == 0 ) strcat(toprint," & \n"); 
    901          else strcat(toprint,"\n     & "); 
    902          strcat(toprint," % ix(3)"); 
    903       } 
    904       else if ( whichone == 27 ) /* Agrif_Iy                                  */ 
    905       { 
    906          sprintf(toprint,"Agrif_Curgrid"); 
    907          if( retour77 == 0 ) strcat(toprint," & \n"); 
    908          else strcat(toprint,"\n     & "); 
    909          strcat(toprint,"% ix(2)"); 
    910       } 
    911       else if ( whichone == 28 ) /* Agrif_Ix                                  */ 
    912       { 
    913          sprintf(toprint,"Agrif_Curgrid"); 
    914          if( retour77 == 0 ) strcat(toprint," & \n"); 
    915          else strcat(toprint,"\n     & "); 
    916          strcat(toprint,"% ix(1)"); 
    917       } 
    918       else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */ 
    919       { 
    920          sprintf(toprint,"Agrif_nbfixedgrids"); 
    921       } 
    922       else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */ 
    923       { 
    924          sprintf(toprint,"Agrif_Curgrid"); 
    925          if( retour77 == 0 ) strcat(toprint," & \n"); 
    926          else strcat(toprint,"\n     & "); 
    927          strcat(toprint,"% ngridstep"); 
    928       } 
    929       /*                                                                      */ 
    930       if ( whichone == 1 || whichone == 2 ) 
    931       { 
    932          Save_Length(toprint,43); 
    933          tofich(fortranout,toprint,2); 
    934       } 
    935       else 
    936       { 
    937 /*         if( retour77 == 0 ) fprintf(fortranout," & \n"); 
    938          else fprintf(fortranout,"\n     & ");*/ 
    939          Save_Length(toprint,43); 
    940          fprintf(fortranout,"%s",toprint); 
    941       } 
    942    } 
    943 } 
    944  
     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} 
    945788 
    946789/******************************************************************************/ 
    … …  
    953796/*                                                                            */ 
    954797/******************************************************************************/ 
    955 void Instanciation_0(char *ident) 
    956 { 
    957    listvar *newvar; 
    958    int out; 
    959  
    960    if ( firstpass == 0 && sameagrifargument == 1 ) 
    961    { 
    962       newvar = List_Global_Var; 
    963  
    964       out=0; 
    965       while ( newvar && out == 0 ) 
    966       { 
    967          if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    968          else newvar=newvar->suiv; 
    969       } 
    970  
    971       if ( out == 0 ) 
    972       { 
    973          newvar = List_Common_Var; 
    974  
    975          out=0; 
    976          while ( newvar && out == 0 ) 
    977          { 
     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        { 
    978809            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    979             else newvar=newvar->suiv; 
    980          } 
    981       } 
    982       if ( out == 0 ) 
    983       { 
    984          newvar = List_ModuleUsed_Var; 
    985  
    986          out=0; 
    987          while ( newvar && out == 0 ) 
    988          { 
    989             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
    990             else newvar=newvar->suiv; 
    991          } 
    992       } 
    993  
    994       if ( out == 1 ) 
    995       { 
    996          /* then write the instanciation                                      */ 
    997          fprintf(fortranout,"\n      %s = %s",ident, 
    998                                           vargridcurgridtabvars(newvar->var,3)); 
    999          colnum = 0; 
    1000       } 
    1001    } 
    1002    sameagrifargument = 0; 
    1003 } 
     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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c

    r2715 r5656  
    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; 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c

    r2528 r5656  
    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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c

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

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c

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

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c

    r2528 r5656  
    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; 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c

    r2528 r5656  
    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// } 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c

    r2715 r5656  
    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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c

    r2528 r5656  
    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; 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c

    r2715 r5656  
    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} 

  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c

    r2528 r5656  
    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 ) 
     114           printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100); 
    157115   } 
    158    if ( whichone == 13 && strlen(nom) > length_v_IntentSpec ) 
     116   if ( whichone == 44 && len_nom > length_toprinttmp_utilchar ) 
    159117   { 
    160       length_v_IntentSpec       = strlen(nom); 
    161       if ( length_v_IntentSpec > LONG_C ) 
    162       { 
    163          printf("WARNING 13 : The value of LONG_C - define in decl.h -\n"); 
    164          printf("             should be upgrated to %d\n", 
    165                                                        length_v_IntentSpec+100); 
    166       } 
     118      length_toprinttmp_utilchar = len_nom; 
     119      if ( length_toprinttmp_utilchar > LONG_M) 
     120           printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100); 
    167121   } 
    168    if ( whichone == 14 && strlen(nom) > length_v_initialvalue ) 
     122   if ( whic