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 663 for trunk/AGRIF/LIB/Writedeclarations.c – NEMO

Ignore:
Timestamp:
2007-05-25T18:00:33+02:00 (17 years ago)
Author:
opalod
Message:

RB: update CONV

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/LIB/Writedeclarations.c

    r530 r663  
    33/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */ 
    44/*                                                                            */ 
    5 /* Copyright or © or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */ 
    6 /*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */ 
     5/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */ 
     6/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */ 
    77/* This software is governed by the CeCILL-C license under French law and     */ 
    88/* abiding by the rules of distribution of free software.  You can  use,      */ 
    … …  
    3131/* knowledge of the CeCILL-C license and that you accept its terms.           */ 
    3232/******************************************************************************/ 
    33 /* version 1.0                                                                */ 
     33/* version 1.6                                                                */ 
    3434/******************************************************************************/ 
    3535#include <stdio.h> 
    … …  
    5454  char tmpligne[LONGLIGNE]; 
    5555 
    56   sprintf (ligne, "%s", v->typevar); 
    57   if ( v->c_star == 1 ) strcat(ligne,"*"); 
     56  if ( !strcasecmp(v->v_typevar,"") ) 
     57  { 
     58     printf("WARNING : The type of the variable %s \n",v->v_nomvar); 
     59     printf("          is unknown. CONV should define a type\n"); 
     60  } 
     61  sprintf (ligne, "%s", v->v_typevar); 
     62  if ( v->v_c_star == 1 ) strcat(ligne,"*"); 
    5863  /* We should give the precision of the variable if it has been given        */ 
    59   if ( strcasecmp(v->precision,"") ) 
    60   { 
    61      sprintf(tmpligne,"(%s)",v->precision); 
     64  if ( strcasecmp(v->v_precision,"") ) 
     65  { 
     66     sprintf(tmpligne,"(%s)",v->v_precision); 
    6267     strcat(ligne,tmpligne); 
    6368  } 
    64   if (strcasecmp(v->dimchar,"")) 
    65   { 
    66      sprintf(tmpligne,"(%s)",v->dimchar); 
     69  if (strcasecmp(v->v_dimchar,"")) 
     70  { 
     71     sprintf(tmpligne,"(%s)",v->v_dimchar); 
    6772     strcat(ligne,tmpligne); 
    6873  } 
    69   if ( strcasecmp(v->nameinttypename,"") ) 
    70   { 
    71      sprintf(tmpligne,"*%s",v->nameinttypename); 
     74  if ( strcasecmp(v->v_nameinttypename,"") ) 
     75  { 
     76     sprintf(tmpligne,"*%s",v->v_nameinttypename); 
    7277     strcat(ligne,tmpligne); 
    7378  } 
    74   if (strcasecmp (v->IntentSpec, "")) 
    75   { 
    76      sprintf(tmpligne,",INTENT(%s) ",v->IntentSpec); 
     79  if (strcasecmp (v->v_IntentSpec, "")) 
     80  { 
     81     sprintf(tmpligne,",INTENT(%s) ",v->v_IntentSpec); 
    7782     strcat(ligne,tmpligne); 
    78   }    
    79   if ( v->VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER"); 
    80   if ( v->PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC");   
    81   if ( v->PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE");  
    82   if ( v->ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL");   
    83   if ( v->allocatable == 1 && v->save ==0 ) strcat(ligne,", ALLOCATABLE"); 
    84   if ( v->optionaldeclare == 1 ) strcat(ligne,", OPTIONAL"); 
    85   if ( v->pointerdeclare == 1 ) strcat(ligne,", POINTER"); 
     83  } 
     84  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER"); 
     85  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC"); 
     86  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE"); 
     87  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL"); 
     88  if ( v->v_allocatable         == 1 && 
     89       v->v_save                == 0 ) strcat(ligne,", ALLOCATABLE"); 
     90  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL"); 
     91  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER"); 
    8692} 
    8793 
    … …  
    98104/*                                                                            */ 
    99105/******************************************************************************/ 
    100 void  WriteScalarDeclaration(variable *v,char ligne[LONGLIGNE]) 
     106void WriteScalarDeclaration(variable *v,char ligne[LONGLIGNE]) 
    101107{ 
    102108 
    103109  strcat (ligne, " :: "); 
    104   strcat (ligne, v->nomvar); 
    105   if ( strcasecmp(v->vallengspec,"") ) strcat(ligne,v->vallengspec); 
    106   if ( v->VariableIsParameter == 1 )  
     110  strcat (ligne, v->v_nomvar); 
     111  if ( strcasecmp(v->v_vallengspec,"") ) strcat(ligne,v->v_vallengspec); 
     112  if ( v->v_VariableIsParameter == 1 ) 
    107113  { 
    108114     strcat(ligne," = "); 
    109      strcat(ligne,v->initialvalue); 
     115     strcat(ligne,v->v_initialvalue); 
    110116  } 
    111117} 
    … …  
    124130/*                                                                            */ 
    125131/******************************************************************************/ 
    126 void  WriteTableDeclaration(variable * v,char ligne[LONGLIGNE],int tmpok) 
     132void WriteTableDeclaration(variable * v,char ligne[LONGLIGNE],int tmpok) 
    127133{ 
    128134  char newname[LONGNOM]; 
    129135 
    130136  strcat (ligne, ", Dimension("); 
    131   if ( v->dimensiongiven == 1 && tmpok == 1 ) 
    132                                            strcat(ligne,v->readedlistdimension); 
    133   if ( v->dimensiongiven == 1 && tmpok == 0 ) 
     137  if ( v->v_dimensiongiven == 1 && tmpok == 1 ) 
     138                                         strcat(ligne,v->v_readedlistdimension); 
     139  if ( v->v_dimensiongiven == 1 && tmpok == 0 ) 
    134140  { 
    135141     strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    136                                           (v->readedlistdimension,globliste,0)); 
    137      if ( !strcasecmp(newname,v->readedlistdimension) ) 
    138      { 
    139         strcpy(newname,"");      
     142                                  (v->v_readedlistdimension,List_Global_Var,0)); 
     143     if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
     144     { 
     145        strcpy(newname,""); 
     146        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
     147                                 (v->v_readedlistdimension,List_Common_Var,0)); 
     148        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
     149     } 
     150     if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
     151     { 
     152        strcpy(newname,""); 
    140153        /* la liste des use de cette subroutine                               */ 
    141154        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    142                                  (v->readedlistdimension,globalvarofusefile,0)); 
    143         if ( !strcasecmp(newname,"") ) strcat(newname,v->readedlistdimension); 
     155                              (v->v_readedlistdimension,List_ModuleUsed_Var,0)); 
     156        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    144157     } 
    145158     strcat(ligne,newname); 
    … …  
    147160  strcat (ligne, ")"); 
    148161  strcat (ligne, " :: "); 
    149   strcat (ligne, v->nomvar);   
    150   if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->vallengspec); 
    151   if ( !strcasecmp (v->typevar, "character") ) strcat(ligne,vargridparam(v,0)); 
     162  strcat (ligne, v->v_nomvar); 
     163  if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec); 
     164/*  if ( !strcasecmp (v->v_typevar, "character") ) 
     165                              strcat(ligne,vargridparam(v,0));*/ 
     166  if ( v->v_VariableIsParameter == 1 ) 
     167  { 
     168     strcat(ligne," = "); 
     169     strcat(ligne,v->v_initialvalue); 
     170  } 
    152171} 
    153172 
    … …  
    164183/*                                                                            */ 
    165184/******************************************************************************/ 
    166 void writevardeclaration (listvar * var_record, FILE *fileout) 
     185void writevardeclaration (listvar * var_record, FILE *fileout, int value) 
    167186{ 
    168187  FILE *filecommon; 
    … …  
    174193  newvar = var_record; 
    175194 
    176   if ( newvar->var->save == 0 || inmodulemeet == 0 ) 
     195  if ( newvar->var->v_save == 0 || inmodulemeet == 0 ) 
    177196  { 
    178197     v = newvar->var; 
    179198     WriteBeginDeclaration(v,ligne); 
    180      if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    181      else WriteTableDeclaration(v,ligne,0); 
    182  
    183      if ( strcasecmp(v->initialvalue,"") ) 
     199     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
     200     else WriteTableDeclaration(v,ligne,value); 
     201 
     202     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") ) 
    184203     { 
    185204        strcat(ligne," = "); 
    186         strcat(ligne,v->initialvalue); 
    187      }   
     205        strcat(ligne,v->v_initialvalue); 
     206     } 
    188207     tofich (filecommon, ligne,1); 
    189208  } 
    … …  
    191210 
    192211 
    193 /******************************************************************************/ 
    194 /*                      NonGridDepDeclaration                                 */ 
    195 /******************************************************************************/ 
    196 /* This subroutine is used to change the variables declaration                */ 
    197 /*                                                                            */ 
    198 /******************************************************************************/ 
    199 /*                                                                            */ 
    200 /*  integer variable(nb) ----------->                                         */ 
    201 /*                      INTEGER, DIMENSION(:),Pointer :: variable             */ 
    202 /*                                                                            */ 
    203 /******************************************************************************/ 
    204 void NonGridDepDeclaration(listvar * deb_common) 
    205 { 
    206   listvar *newvar; 
    207  
    208   if ( ( SaveDeclare == 0 || aftercontainsdeclare == 0 ) && listenotgriddepend )  
    209   { 
    210      newvar = deb_common; 
    211      while (newvar) 
    212      { 
    213         if ( VarIsNonGridDepend(newvar->var->nomvar) == 1 )  
    214                                        writevardeclaration (newvar, fortranout); 
    215         newvar = newvar->suiv; 
    216      } 
    217   } 
    218 } 
    219  
    220  
    221 /******************************************************************************/ 
    222 /*                       writedeclaration                                     */ 
    223 /******************************************************************************/ 
    224 /* This subroutine is used to write the declaration if variable present in    */ 
    225 /*    the deb_common and also in the presentinthislist list file              */ 
    226 /******************************************************************************/ 
    227 /*                                                                            */ 
    228 /*  integer variable(nb) ----------->                                         */ 
    229 /*                      INTEGER, DIMENSION(1:nb),Pointer :: variable          */ 
    230 /*                                                                            */ 
    231 /******************************************************************************/ 
    232 void writedeclaration (listvar * deb_common, FILE *fileout, listvar *presentinthislist) 
    233 { 
    234   FILE *filecommon; 
    235   listvar *newvar; 
    236   listvar *parcours; 
    237   variable *v; 
    238   char ligne[LONGLIGNE]; 
    239   int out; 
    240  
    241   filecommon=fileout; 
    242  
    243   newvar = deb_common; 
    244   while (newvar) 
    245   { 
    246      if ( newvar->var->save == 0 || inmodulemeet == 0 ) 
    247      { 
    248         parcours = presentinthislist; 
    249         /* we should write declaration of variable present in the list        */ 
    250         /* presentinthislist                                                  */ 
    251         /* if presentinthislist is empty we should write all declarations     */ 
    252         out = 0 ; 
    253         while ( parcours && out == 0 ) 
    254         { 
    255             /* if we find this variable in the presentinthislist, we          */ 
    256             /* could write it                                                 */ 
    257            if ( !strcasecmp(parcours->var->nomvar,newvar->var->nomvar) && 
    258                 !strcasecmp(parcours->var->subroutinename, 
    259                                           newvar->var->subroutinename)  
    260                ) out = 1; 
    261            else parcours =parcours ->suiv; 
    262         } 
    263         if ( out == 0 || !presentinthislist) 
    264         { 
    265            /* if the variable has not been found or if the                    */ 
    266            /* presentinthislist is empty, we do not write the declaration     */ 
    267         } 
    268         else 
    269         { 
    270            /* else we could write it                                          */ 
    271            v = newvar->var; 
    272            WriteBeginDeclaration(v,ligne); 
    273            if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    274            else WriteTableDeclaration(v,ligne,0); 
    275              
    276            if ( strcasecmp(v->initialvalue,"") ) 
    277            { 
    278               strcat(ligne, "="); 
    279               strcat(ligne, v->initialvalue); 
    280            } 
    281            tofich (filecommon, ligne,1); 
    282         } 
    283      } 
    284      newvar = newvar->suiv; 
    285   } 
    286 } 
    287  
    288 /******************************************************************************/ 
    289 /*                       writesub_loopdeclaration                             */ 
    290 /******************************************************************************/ 
    291 /* This subroutine is used to write the declaration part of subloop           */ 
    292 /*    subroutines                                                             */ 
    293 /******************************************************************************/ 
    294 /*                                                                            */ 
    295 /*  integer variable(nb) ----------->                                         */ 
    296 /*                                                                            */ 
    297 /*          INTEGER, DIMENSION(1:nb)         :: variable                      */ 
    298 /*                                                                            */ 
    299 /******************************************************************************/ 
    300 void writesub_loopdeclaration (listvar * deb_common, FILE *fileout) 
    301 { 
    302   listvar *newvar; 
    303   variable *v; 
    304   char ligne[LONGLIGNE]; 
    305   int changeval; 
    306  
    307   tofich (fileout, "",1); 
    308   newvar = deb_common; 
    309   while (newvar) 
    310   { 
    311      if ( !strcasecmp(newvar->var->modulename,subroutinename) ) 
    312      { 
    313         changeval = 0; 
    314         v = newvar->var; 
    315         if ( v->allocatable == 1 && fortran77 == 0 )  
    316         { 
    317            changeval = 1; 
    318            v->allocatable = 0;  
    319         } 
    320         WriteBeginDeclaration(v,ligne); 
    321         if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    322         else WriteTableDeclaration(v,ligne,1); 
    323  
    324         tofich (fileout, ligne,1); 
    325         if ( changeval == 1 )  
    326         { 
    327            v->allocatable = 1; 
    328         } 
    329      } 
    330      newvar = newvar->suiv; 
    331   } 
     212void WriteLocalParamDeclaration() 
     213{ 
     214   listvar *parcours; 
     215 
     216   parcours = List_Parameter_Var; 
     217   while ( parcours ) 
     218   { 
     219      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
     220      { 
     221         writevardeclaration(parcours,fortranout,0); 
     222      } 
     223      parcours = parcours -> suiv; 
     224   } 
     225} 
     226 
     227void WriteFunctionDeclaration() 
     228{ 
     229   listvar *parcours; 
     230 
     231   parcours = List_FunctionType_Var; 
     232   while ( parcours ) 
     233   { 
     234      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     235            strcasecmp(parcours->var->v_typevar,"") 
     236         ) 
     237      { 
     238         writevardeclaration(parcours,fortranout,0); 
     239      } 
     240      parcours = parcours -> suiv; 
     241   } 
     242} 
     243 
     244void WriteSubroutineDeclaration(int value) 
     245{ 
     246   listvar *parcours; 
     247 
     248   parcours = List_SubroutineDeclaration_Var; 
     249   while ( parcours ) 
     250   { 
     251      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     252           parcours->var->v_save == 0                                  && 
     253           parcours->var->v_allocatable == 0                           && 
     254           parcours->var->v_pointerdeclare == 0                        && 
     255           parcours->var->v_VariableIsParameter == 0                   && 
     256           parcours->var->v_common == 0 
     257         ) 
     258      { 
     259         writevardeclaration(parcours,fortranout,value); 
     260      } 
     261      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     262           parcours->var->v_save == 0                                  && 
     263           parcours->var->v_VariableIsParameter == 0                   && 
     264           parcours->var->v_common == 0 
     265              ) 
     266      { 
     267         writevardeclaration(parcours,fortranout,value); 
     268      } 
     269      parcours = parcours -> suiv; 
     270   } 
     271} 
     272 
     273void WriteArgumentDeclaration_beforecall() 
     274{ 
     275   variable *v; 
     276   int position; 
     277   listnom *neededparameter; 
     278   FILE *paramtoamr; 
     279   listvar *newvar; 
     280   char ligne[LONGLIGNE]; 
     281   int out; 
     282   int writeit; 
     283   listnom *parcours; 
     284 
     285   fprintf(fortranout,"#include \"Param_BeforeCall_%s.h\" \n",subroutinename); 
     286   /*                                                                         */ 
     287   sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename); 
     288   paramtoamr = associate (ligne); 
     289   /*                                                                         */ 
     290   neededparameter = (listnom * )NULL; 
     291   /*                                                                         */ 
     292   position = 1; 
     293   newvar = List_SubroutineArgument_Var; 
     294   while ( newvar ) 
     295   { 
     296      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
     297                       newvar->var->v_positioninblock == position 
     298         ) 
     299      { 
     300         position = position + 1; 
     301         writevardeclaration(newvar,fortranout,0); 
     302         neededparameter = writedeclarationintoamr(List_Parameter_Var, 
     303                   paramtoamr,newvar->var,newvar->var->v_subroutinename, 
     304                   neededparameter,subroutinename); 
     305 
     306         newvar = List_SubroutineArgument_Var; 
     307      } 
     308      else newvar = newvar -> suiv; 
     309   } 
     310   fclose(paramtoamr); 
     311} 
     312 
     313void WriteArgumentDeclaration_Sort() 
     314{ 
     315   variable *v; 
     316   int position; 
     317/*   listnom *neededparameter;*/ 
     318   FILE *paramtoamr; 
     319   listvar *newvar; 
     320   char ligne[LONGLIGNE]; 
     321   int out; 
     322   int writeit; 
     323   listnom *parcours; 
     324 
     325   /*                                                                         */ 
     326   position = 1; 
     327   newvar = List_SubroutineArgument_Var; 
     328   while ( newvar ) 
     329   { 
     330      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
     331                       newvar->var->v_positioninblock == position 
     332         ) 
     333      { 
     334         position = position + 1; 
     335         writevardeclaration(newvar,fortranout,1); 
     336         /*                                                                   */ 
     337         newvar = List_SubroutineArgument_Var; 
     338      } 
     339      else newvar = newvar -> suiv; 
     340   } 
     341   /*                                                                         */ 
     342   newvar = List_SubroutineArgument_Var; 
     343   while ( newvar ) 
     344   { 
     345      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
     346                       newvar->var->v_positioninblock == 0           && 
     347                       newvar->var->v_nbdim == 0 
     348         ) 
     349      { 
     350         writevardeclaration(newvar,fortranout,1); 
     351      } 
     352      newvar = newvar -> suiv; 
     353   } 
     354   /*                                                                         */ 
     355   newvar = List_SubroutineArgument_Var; 
     356   while ( newvar ) 
     357   { 
     358      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
     359                       newvar->var->v_positioninblock == 0           && 
     360                       newvar->var->v_nbdim != 0 
     361         ) 
     362      { 
     363         writevardeclaration(newvar,fortranout,1); 
     364      } 
     365      newvar = newvar -> suiv; 
     366   } 
    332367} 
    333368 
    … …  
    341376/*                                                                            */ 
    342377/******************************************************************************/ 
    343 void writedeclarationintoamr (listvar * deb_common, FILE *fileout, 
    344                               listvar *listin , char commonname[LONGNOM]) 
     378listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout, 
     379                              variable *var , char commonname[LONGNOM], 
     380                           listnom *neededparameter, char name_common[LONGNOM]) 
    345381{ 
    346382  listvar *newvar; 
    … …  
    350386  char firstmodule[LONGNOM]; 
    351387  int out; 
    352   listnom *neededparameter; 
    353388  int writeit; 
    354389  listnom *parcours; 
    355390  listnom *parcoursprec; 
    356    
     391 
    357392  parcoursprec = (listnom * )NULL; 
    358   neededparameter = (listnom * )NULL; 
    359393  /* we should list the needed parameter                                      */ 
    360   newvar = listin; 
    361   out = 0 ; 
    362   while ( newvar && out == 0 ) 
    363   { 
    364      if ( strcasecmp(newvar->var->commonname,commonname) ) out = 1; 
    365      else  
    366      { 
    367         /* add the name to the list of needed parameter                       */ 
    368         neededparameter = DecomposeTheNameinlistnom( 
    369                  newvar->var->readedlistdimension, 
    370                  neededparameter ); 
    371         newvar = newvar->suiv; 
    372      } 
    373   } 
     394  if ( !strcasecmp(name_common,commonname) ) 
     395     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension, 
     396                                                               neededparameter); 
    374397  /*                                                                          */ 
    375398  parcours = neededparameter; 
    … …  
    380403     while ( newvar && out == 0 ) 
    381404     { 
    382         if ( !strcasecmp(parcours->nom,newvar->var->nomvar) )  
    383         { 
    384            out=1;  
     405        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) ) 
     406        { 
     407           out=1; 
    385408        /* add the name to the list of needed parameter                       */ 
    386409           neededparameter = DecomposeTheNameinlistnom( 
    387                  newvar->var->initialvalue, 
     410                 newvar->var->v_initialvalue, 
    388411                 neededparameter ); 
    389412        } 
    … …  
    391414     } 
    392415     parcours=parcours->suiv; 
    393    }      
     416   } 
    394417  /*                                                                          */ 
    395418  parcours = neededparameter; 
    … …  
    400423     while ( newvar && out == 0 ) 
    401424     { 
    402         if ( !strcasecmp(parcours->nom,newvar->var->nomvar) )  
    403         { 
    404            out=1;  
     425        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) ) 
     426        { 
     427           out=1; 
    405428        /* add the name to the list of needed parameter                       */ 
    406429           neededparameter = DecomposeTheNameinlistnom( 
    407                  newvar->var->initialvalue, 
     430                 newvar->var->v_initialvalue, 
    408431                 neededparameter ); 
    409432        } 
    … …  
    411434     } 
    412435     parcours=parcours->suiv; 
    413    }      
     436   } 
    414437  /*                                                                          */ 
    415438  strcpy(firstmodule,""); 
    416439  tofich (fileout, "",1); 
     440  parcours = neededparameter; 
     441  while (parcours) 
     442  { 
     443     writeit = 0; 
     444     newvar = deb_common; 
     445     while ( newvar && writeit == 0 ) 
     446     { 
     447        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && 
     448             parcours->o_val == 0 ) 
     449        { 
     450           writeit=1; 
     451           parcours->o_val = 1; 
     452        } 
     453        else newvar = newvar->suiv; 
     454     } 
     455 
     456     if ( writeit == 1  ) 
     457     { 
     458        changeval = 0; 
     459        v = newvar->var; 
     460        if ( v->v_allocatable == 1  ) 
     461        { 
     462           changeval = 1; 
     463           v->v_allocatable = 0; 
     464        } 
     465        WriteBeginDeclaration(v,ligne); 
     466        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
     467        else WriteTableDeclaration(v,ligne,1); 
     468 
     469        tofich (fileout, ligne,1); 
     470        if ( changeval == 1 ) 
     471        { 
     472           v->v_allocatable = 1; 
     473        } 
     474     } 
     475     else 
     476     { 
     477        if (  strncasecmp(parcours->o_nom,"mpi_",4) == 0 && 
     478              shouldincludempif                     == 1 ) 
     479        { 
     480           shouldincludempif = 0; 
     481           fprintf(fileout,"      include \'mpif.h\' \n"); 
     482        } 
     483     } 
     484     parcours=parcours->suiv; 
     485  } 
     486  return neededparameter; 
     487} 
     488 
     489 
     490/******************************************************************************/ 
     491/*                       writesub_loopdeclaration_scalar                      */ 
     492/******************************************************************************/ 
     493/* This subroutine is used to write the declaration part of subloop           */ 
     494/*    subroutines                                                             */ 
     495/******************************************************************************/ 
     496/*                                                                            */ 
     497/*  integer variable(nb) ----------->                                         */ 
     498/*                                                                            */ 
     499/*          INTEGER, DIMENSION(1:nb)         :: variable                      */ 
     500/*                                                                            */ 
     501/******************************************************************************/ 
     502void writesub_loopdeclaration_scalar (listvar * deb_common, FILE *fileout) 
     503{ 
     504  listvar *newvar; 
     505  variable *v; 
     506  char ligne[LONGLIGNE]; 
     507 
     508  tofich (fileout, "",1); 
    417509  newvar = deb_common; 
    418510  while (newvar) 
    419511  { 
    420      writeit = 0; 
    421      parcours = neededparameter; 
    422      while ( parcours && writeit == 0 ) 
    423      { 
    424         if ( !strcasecmp(parcours->nom,newvar->var->nomvar) ) 
    425         { 
    426            writeit=1; 
    427            if ( parcours == neededparameter ) 
    428            { 
    429               neededparameter = neededparameter->suiv; 
    430            } 
    431            else 
    432            { 
    433               parcoursprec->suiv= parcours->suiv;            
    434            } 
    435         } 
    436         else 
    437         { 
    438            parcoursprec=parcours; 
    439            parcours=parcours->suiv; 
    440         } 
    441      } 
    442       
    443      if ( writeit == 1  ) 
    444      { 
    445         changeval = 0; 
     512     if ( newvar->var->v_nbdim == 0 && 
     513          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  && 
     514           newvar->var->v_allocatable == 0                           && 
     515           newvar->var->v_pointerdeclare == 0 
     516         ) 
     517     { 
    446518        v = newvar->var; 
    447         if ( v->allocatable == 1 && fortran77 == 0 )  
    448         { 
    449            changeval = 1; 
    450            v->allocatable = 0;  
    451         } 
     519 
    452520        WriteBeginDeclaration(v,ligne); 
    453         if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    454         else WriteTableDeclaration(v,ligne,1); 
    455  
     521        WriteScalarDeclaration(v,ligne); 
    456522        tofich (fileout, ligne,1); 
    457         if ( changeval == 1 )  
    458         { 
    459            v->allocatable = 1; 
    460         } 
    461523     } 
    462524     newvar = newvar->suiv; 
    … …  
    464526} 
    465527 
    466  
    467  
    468 /******************************************************************************/ 
    469 /*                     writedeclarationsubroutinedeclaration                  */ 
    470 /******************************************************************************/ 
    471 /* This subroutine is used to write the declaration of parameters needed in   */ 
    472 /*    in the table definition. This subroutine is used for the declaration    */ 
    473 /*    part of original subroutines                                            */ 
    474 /******************************************************************************/ 
    475 /*                                                                            */ 
    476 /*                                                                            */ 
    477 /******************************************************************************/ 
    478 void  writedeclarationsubroutinedeclaration(listvar * deb_common, FILE *fileout, 
    479                               listvar *listin) 
     528/******************************************************************************/ 
     529/*                       writesub_loopdeclaration_tab                         */ 
     530/******************************************************************************/ 
     531/* This subroutine is used to write the declaration part of subloop           */ 
     532/*    subroutines                                                             */ 
     533/******************************************************************************/ 
     534/*                                                                            */ 
     535/*  integer variable(nb) ----------->                                         */ 
     536/*                                                                            */ 
     537/*          INTEGER, DIMENSION(1:nb)         :: variable                      */ 
     538/*                                                                            */ 
     539/******************************************************************************/ 
     540void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout) 
    480541{ 
    481542  listvar *newvar; 
    … …  
    483544  char ligne[LONGLIGNE]; 
    484545  int changeval; 
    485   char firstmodule[LONGNOM]; 
    486   int out; 
    487   listnom *neededparameter; 
    488   int writeit; 
    489   listnom *parcours; 
    490   listnom *parcoursprec; 
    491    
    492   parcoursprec = (listnom * )NULL; 
    493   neededparameter = (listnom * )NULL; 
    494   /* we should list the needed parameter                                      */ 
    495   newvar = listin; 
    496   while ( newvar ) 
    497   { 
    498      if ( !strcasecmp(newvar->var->subroutinename,subroutinename) ) 
    499      { 
    500         /* add the name to the list of needed parameter                       */ 
    501         neededparameter = DecomposeTheNameinlistnom( 
    502                  newvar->var->readedlistdimension, 
    503                  neededparameter ); 
    504      } 
    505      newvar = newvar->suiv; 
    506   } 
    507   /*                                                                          */ 
    508   parcours = neededparameter; 
    509   while (parcours) 
    510   { 
    511      newvar = deb_common; 
    512      out = 0 ; 
    513      while ( newvar && out == 0 ) 
    514      { 
    515         if ( !strcasecmp(parcours->nom,newvar->var->nomvar) )  
    516         { 
    517            out=1;  
    518         /* add the name to the list of needed parameter                       */ 
    519            neededparameter = DecomposeTheNameinlistnom( 
    520                  newvar->var->initialvalue, 
    521                  neededparameter ); 
    522         } 
    523         else newvar=newvar->suiv; 
    524      } 
    525      parcours=parcours->suiv; 
    526    }      
    527    /*                                                                         */ 
    528   strcpy(firstmodule,""); 
     546 
    529547  tofich (fileout, "",1); 
    530548  newvar = deb_common; 
    531549  while (newvar) 
    532550  { 
    533      writeit = 0; 
    534      parcours = neededparameter; 
    535      while ( parcours && writeit == 0 ) 
    536      { 
    537         if ( !strcasecmp(parcours->nom,newvar->var->nomvar) ) 
    538         { 
    539            writeit=1; 
    540            if ( parcours == neededparameter ) 
    541            { 
    542               neededparameter = neededparameter->suiv; 
    543            } 
    544            else 
    545            { 
    546               parcoursprec->suiv= parcours->suiv;            
    547            } 
    548         } 
    549         else 
    550         { 
    551            parcoursprec=parcours; 
    552            parcours=parcours->suiv; 
    553         } 
    554      } 
    555       
    556      if ( writeit == 1  ) 
     551     if ( newvar->var->v_nbdim != 0                                 && 
     552          !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
     553          newvar->var->v_allocatable == 0                           && 
     554          newvar->var->v_pointerdeclare == 0 
     555        ) 
    557556     { 
    558557        changeval = 0; 
    559558        v = newvar->var; 
    560         if ( v->allocatable == 1 && fortran77 == 0 )  
     559        if ( v->v_allocatable == 1 ) 
    561560        { 
    562561           changeval = 1; 
    563            v->allocatable = 0;  
     562           v->v_allocatable = 0; 
    564563        } 
    565564        WriteBeginDeclaration(v,ligne); 
    566         if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    567         else WriteTableDeclaration(v,ligne,1); 
    568  
     565        WriteTableDeclaration(v,ligne,1); 
    569566        tofich (fileout, ligne,1); 
    570         if ( changeval == 1 )  
    571         { 
    572            v->allocatable = 1; 
    573         } 
     567        if ( changeval == 1 ) v->v_allocatable = 1; 
    574568     } 
    575569     newvar = newvar->suiv; 
Note: See TracChangeset for help on using the changeset viewer.