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 6808 for branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c – NEMO

Ignore:
Timestamp:
2016-07-19T10:38:35+02:00 (8 years ago)
Author:
jamesharle
Message:

merge with trunk@6232 for consistency with SSB code

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c

    r3294 r6808  
    5050/*                                                                            */ 
    5151/******************************************************************************/ 
    52 void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility) 
    53 { 
    54   char tmpligne[LONG_4C]; 
     52void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility) 
     53{ 
     54  char tmpligne[LONG_M]; 
     55  int precision_given ; 
    5556 
    5657  if ( !strcasecmp(v->v_typevar,"") ) 
    5758  { 
    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    
    62   sprintf (ligne, "%s", v->v_typevar); 
    63   if ( v->v_c_star == 1 ) strcat(ligne,"*"); 
    64    
     59     printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar); 
     60     printf("#          CONV should define a type\n"); 
     61  } 
     62 
     63  sprintf(line, "%s", v->v_typevar); 
     64  if ( v->v_c_star == 1 ) strcat(line, "*"); 
     65 
    6566  /* We should give the precision of the variable if it has been given        */ 
     67  precision_given = 0; 
    6668  if ( strcasecmp(v->v_precision,"") ) 
    6769  { 
    68      sprintf(tmpligne,"(%s)",v->v_precision); 
    69      Save_Length(tmpligne,49); 
    70      strcat(ligne,tmpligne); 
    71   } 
    72    
     70     sprintf(tmpligne, "(%s)", v->v_precision); 
     71     Save_Length(tmpligne, 49); 
     72     strcat(line, tmpligne); 
     73     precision_given = 1; 
     74  } 
     75 
    7376  if (strcasecmp(v->v_dimchar,"")) 
    7477  { 
    7578     sprintf(tmpligne,"(%s)",v->v_dimchar); 
    76      Save_Length(tmpligne,49); 
    77      strcat(ligne,tmpligne); 
    78   } 
    79    
    80   if ( strcasecmp(v->v_nameinttypename,"") ) 
     79     Save_Length(tmpligne, 49); 
     80     strcat(line,tmpligne); 
     81  } 
     82 
     83  if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") )) 
    8184  { 
    8285     sprintf(tmpligne,"*%s",v->v_nameinttypename); 
    83      Save_Length(tmpligne,49); 
    84      strcat(ligne,tmpligne); 
     86     Save_Length(tmpligne, 49); 
     87     strcat(line,tmpligne); 
    8588  } 
    8689  if (strcasecmp (v->v_IntentSpec, "")) 
    8790  { 
    88      sprintf(tmpligne,",INTENT(%s) ",v->v_IntentSpec); 
    89      Save_Length(tmpligne,49); 
    90      strcat(ligne,tmpligne); 
    91   } 
    92   if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER"); 
    93   if (visibility == 1) 
    94   { 
    95   if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC"); 
    96   if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE"); 
    97   } 
    98   if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL"); 
    99   if ( v->v_allocatable         == 1) 
    100        {strcat(ligne,", ALLOCATABLE"); 
    101        } 
    102   if ( v->v_target         == 1) 
    103        {strcat(ligne,", TARGET"); 
    104        } 
    105   if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL"); 
    106   if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER"); 
    107   Save_Length(ligne,45); 
     91     sprintf(tmpligne,", intent(%s)", v->v_IntentSpec); 
     92     Save_Length(tmpligne, 49); 
     93     strcat(line,tmpligne); 
     94  } 
     95  if ( v->v_VariableIsParameter ) strcat(line, ", parameter"); 
     96  if ( visibility ) 
     97  { 
     98      if ( v->v_PublicDeclare  )  strcat(line, ", public"); 
     99      if ( v->v_PrivateDeclare )  strcat(line, ", private"); 
     100  } 
     101  if ( v->v_ExternalDeclare ) strcat(line, ", external"); 
     102  if ( v->v_allocatable     ) strcat(line, ", allocatable"); 
     103  if ( v->v_target          ) strcat(line, ", target"); 
     104  if ( v->v_optionaldeclare ) strcat(line, ", optional"); 
     105  if ( v->v_pointerdeclare  ) strcat(line, ", pointer"); 
     106  Save_Length(line, 45); 
    108107} 
    109108 
    … …  
    120119/*                                                                            */ 
    121120/******************************************************************************/ 
    122 void WriteScalarDeclaration(variable *v,char ligne[LONG_4C]) 
    123 { 
    124  
    125   strcat (ligne, " :: "); 
    126   strcat (ligne, v->v_nomvar); 
    127   if ( strcasecmp(v->v_vallengspec,"") ) strcat(ligne,v->v_vallengspec); 
    128   if ( v->v_VariableIsParameter == 1 ) 
    129   { 
    130      strcat(ligne," = "); 
    131      strcat(ligne,v->v_initialvalue); 
    132   } 
    133   Save_Length(ligne,45); 
    134 } 
    135  
     121void WriteScalarDeclaration( variable *v, char line[LONG_M]) 
     122{ 
     123    strcat(line, " :: "); 
     124    strcat(line, v->v_nomvar); 
     125 
     126    if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec); 
     127    if ( v->v_VariableIsParameter ) 
     128    { 
     129        strcat(line," = "); 
     130        strcat(line, v->v_initialvalue); 
     131    } 
     132    Save_Length(line, 45); 
     133} 
    136134 
    137135/******************************************************************************/ 
    … …  
    147145/*                                                                            */ 
    148146/******************************************************************************/ 
    149 void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok) 
    150 { 
    151   char newname[LONG_4C]; 
    152  
    153   strcat (ligne, ", Dimension("); 
    154  
    155   if ( v->v_dimensiongiven == 1 && tmpok == 1 ) 
    156   { 
    157                                          strcat(ligne,v->v_readedlistdimension); 
    158                                          } 
    159   if ( v->v_dimensiongiven == 1 && tmpok == 0 ) 
    160   { 
    161      strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    162                                   (v->v_readedlistdimension,List_Global_Var,0)); 
    163  
    164      if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    165  
    166         strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    167                                  (newname,List_Common_Var,0)); 
    168  
    169      if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);  
    170       
    171         strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    172                               (newname,List_ModuleUsed_Var,0)); 
     147void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok) 
     148{ 
     149    char newname[LONG_M]; 
     150 
     151    strcat (ligne, ", dimension("); 
     152 
     153    if ( v->v_dimensiongiven == 1 && tmpok == 1 )   strcat(ligne,v->v_readedlistdimension); 
     154    if ( v->v_dimensiongiven == 1 && tmpok == 0 ) 
     155    { 
     156        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var)); 
    173157        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    174158 
    175      Save_Length(newname,47); 
    176      strcat(ligne,newname); 
    177   } 
    178   strcat (ligne, ")"); 
    179   strcat (ligne, " :: "); 
    180   strcat (ligne, v->v_nomvar); 
    181   if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec); 
    182  
    183   if ( v->v_VariableIsParameter == 1 ) 
    184   { 
    185      strcat(ligne," = "); 
    186      strcat(ligne,v->v_initialvalue); 
    187   } 
    188   Save_Length(ligne,45); 
    189 } 
    190  
    191 /******************************************************************************/ 
    192 /*                        writevardeclaration                                 */ 
     159        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var)); 
     160        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
     161 
     162        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var)); 
     163        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
     164 
     165        Save_Length(newname,47); 
     166        strcat(ligne,newname); 
     167    } 
     168    strcat(ligne, ") :: "); 
     169    strcat(ligne, v->v_nomvar); 
     170    if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec); 
     171 
     172    if ( v->v_VariableIsParameter == 1 ) 
     173    { 
     174        strcat(ligne," = "); 
     175        strcat(ligne,v->v_initialvalue); 
     176    } 
     177    Save_Length(ligne,45); 
     178} 
     179 
     180/******************************************************************************/ 
     181/*                        WriteVarDeclaration                                 */ 
    193182/******************************************************************************/ 
    194183/* This subroutine is used to write the initial declaration in the file       */ 
    … …  
    201190/*                                                                            */ 
    202191/******************************************************************************/ 
    203 void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility) 
     192void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility ) 
    204193{ 
    205194  FILE *filecommon; 
     195  char ligne[LONG_M]; 
     196 
     197  filecommon = fileout; 
     198 
     199  if ( v->v_save == 0 || inmodulemeet == 0 ) 
     200  { 
     201     WriteBeginDeclaration(v, ligne, visibility); 
     202 
     203     if ( v->v_nbdim == 0 ) 
     204        WriteScalarDeclaration(v, ligne); 
     205     else 
     206        WriteTableDeclaration(v, ligne, value); 
     207 
     208     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") ) 
     209     { 
     210        strcat(ligne," = "); 
     211        strcat(ligne,v->v_initialvalue); 
     212     } 
     213     tofich(filecommon, ligne, 1); 
     214  } 
     215  else 
     216    printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar); 
     217  Save_Length(ligne,45); 
     218} 
     219 
     220 
     221void WriteLocalParamDeclaration(FILE* tofile) 
     222{ 
     223    listvar *parcours; 
     224 
     225    parcours = List_Parameter_Var; 
     226    while ( parcours ) 
     227    { 
     228        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
     229        { 
     230            WriteVarDeclaration(parcours->var, tofile, 0, 1); 
     231        } 
     232        parcours = parcours -> suiv; 
     233    } 
     234} 
     235 
     236void WriteFunctionDeclaration(FILE* tofile, int value) 
     237{ 
     238    listvar *parcours; 
     239 
     240    parcours = List_FunctionType_Var; 
     241    while ( parcours ) 
     242    { 
     243        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) && 
     244              strcasecmp(parcours->var->v_typevar, "") ) 
     245        { 
     246            WriteVarDeclaration(parcours->var, tofile, value, 1); 
     247        } 
     248        parcours = parcours -> suiv; 
     249    } 
     250} 
     251 
     252void WriteSubroutineDeclaration(int value) 
     253{ 
     254    listvar *parcours; 
     255    variable *v; 
     256 
     257    parcours = List_SubroutineDeclaration_Var; 
     258    while ( parcours ) 
     259    { 
     260        v = parcours->var; 
     261        if ( !strcasecmp(v->v_subroutinename, subroutinename)   && 
     262             (v->v_save == 0)                                   && 
     263             (v->v_pointerdeclare == 0)                         && 
     264             (v->v_VariableIsParameter == 0)                    && 
     265             (v->v_common == 0) ) 
     266        { 
     267            WriteVarDeclaration(v, fortran_out, value, 1); 
     268        } 
     269        else if ( !strcasecmp(v->v_subroutinename, subroutinename)  && 
     270                  (v->v_save == 0)                                  && 
     271                  (v->v_VariableIsParameter == 0)                   && 
     272                  (v->v_common == 0) ) 
     273        { 
     274            WriteVarDeclaration(v, fortran_out, value, 1); 
     275        } 
     276        parcours = parcours -> suiv; 
     277    } 
     278} 
     279 
     280void WriteArgumentDeclaration_beforecall() 
     281{ 
     282    int position; 
     283    listnom *neededparameter; 
     284    FILE *paramtoamr; 
     285    listvar *parcours; 
     286    variable *v; 
     287    char ligne[LONG_M]; 
     288 
     289    fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename); 
     290 
     291    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename); 
     292    paramtoamr = open_for_write(ligne); 
     293 
     294    neededparameter = (listnom * )NULL; 
     295    position = 1; 
     296    parcours = List_SubroutineArgument_Var; 
     297 
     298    while ( parcours ) 
     299    { 
     300        v = parcours->var; 
     301        if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) ) 
     302        { 
     303            position++; 
     304            WriteVarDeclaration(v, fortran_out, 0, 1); 
     305            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr, 
     306                                    v, v->v_subroutinename, neededparameter, subroutinename); 
     307            parcours = List_SubroutineArgument_Var; 
     308        } 
     309        else parcours = parcours -> suiv; 
     310    } 
     311    Save_Length(ligne,45); 
     312 
     313    // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module 
     314    if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) ) 
     315    { 
     316        fprintf(paramtoamr, "      interface\n"); 
     317        if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename); 
     318        else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename); 
     319        WriteVariablelist_subloop(ligne); 
     320        WriteVariablelist_subloop_Def(ligne); 
     321        strcat(ligne,")"); 
     322        Save_Length(ligne,45); 
     323        tofich(paramtoamr,ligne,1); 
     324 
     325        listusemodule *parcours_mod; 
     326        parcours_mod = List_NameOfModuleUsed; 
     327        while ( parcours_mod ) 
     328        { 
     329            if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) ) 
     330            { 
     331                fprintf(paramtoamr, "          use %s\n", parcours_mod->u_usemodule); 
     332            } 
     333            parcours_mod = parcours_mod->suiv; 
     334        } 
     335        fprintf(paramtoamr, "          implicit none\n"); 
     336        WriteLocalParamDeclaration(paramtoamr); 
     337        writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr); 
     338        writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr); 
     339        WriteArgumentDeclaration_Sort(paramtoamr); 
     340        WriteFunctionDeclaration(paramtoamr, 1); 
     341 
     342        sprintf(ligne,"  end subroutine Sub_Loop_%s\n", subroutinename); 
     343        tofich(paramtoamr, ligne, 1); 
     344        fprintf(paramtoamr, "      end interface\n"); 
     345    } 
     346    fclose(paramtoamr); 
     347} 
     348 
     349void WriteArgumentDeclaration_Sort(FILE* tofile) 
     350{ 
     351    int position = 1; 
     352    listvar *parcours; 
     353 
     354    parcours = List_SubroutineArgument_Var; 
     355    while ( parcours ) 
     356    { 
     357        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) && 
     358                         parcours->var->v_positioninblock == position ) 
     359        { 
     360            position = position + 1; 
     361            WriteVarDeclaration(parcours->var, tofile, 1, 1); 
     362            parcours = List_SubroutineArgument_Var; 
     363        } 
     364        else parcours = parcours -> suiv; 
     365    } 
     366 
     367    parcours = List_SubroutineArgument_Var; 
     368    while ( parcours ) 
     369    { 
     370        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     371                         parcours->var->v_positioninblock == 0           && 
     372                        parcours->var->v_nbdim == 0 ) 
     373        { 
     374            WriteVarDeclaration(parcours->var,tofile,1,1); 
     375        } 
     376        parcours = parcours -> suiv; 
     377    } 
     378 
     379    parcours = List_SubroutineArgument_Var; 
     380    while ( parcours ) 
     381    { 
     382        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     383                         parcours->var->v_positioninblock == 0           && 
     384                         parcours->var->v_nbdim != 0 ) 
     385        { 
     386            WriteVarDeclaration(parcours->var, tofile, 1, 1); 
     387        } 
     388        parcours = parcours -> suiv; 
     389    } 
     390} 
     391 
     392/******************************************************************************/ 
     393/*                      writedeclarationintoamr                               */ 
     394/******************************************************************************/ 
     395/* This subroutine is used to write the declaration of parameters needed in   */ 
     396/*    allocation subroutines creates in toamr.c                               */ 
     397/******************************************************************************/ 
     398/*                                                                            */ 
     399/*                                                                            */ 
     400/******************************************************************************/ 
     401listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout, 
     402                              variable *var , const char *commonname, 
     403                           listnom *neededparameter, const char *name_common) 
     404{ 
    206405  listvar *newvar; 
    207406  variable *v; 
    208   char ligne[LONG_4C]; 
    209  
    210   filecommon=fileout; 
    211   newvar = var_record; 
    212    
    213   if ( newvar->var->v_save == 0 || inmodulemeet == 0 ) 
    214   { 
    215      v = newvar->var; 
    216      if (mark == 1) fprintf(fileout,"222222233333333\n"); 
    217      WriteBeginDeclaration(v,ligne,visibility); 
    218  
    219      if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    220      else WriteTableDeclaration(v,ligne,value); 
    221  
    222      if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") ) 
    223      { 
    224         strcat(ligne," = "); 
    225         strcat(ligne,v->v_initialvalue); 
    226      } 
    227       
    228      tofich (filecommon, ligne,1); 
    229      if (mark == 1) fprintf(fileout,"44444433333333\n");      
    230   } 
    231   Save_Length(ligne,45); 
    232    
    233 } 
    234  
    235  
    236 void WriteLocalParamDeclaration() 
    237 { 
    238    listvar *parcours; 
    239  
    240    parcours = List_Parameter_Var; 
    241    while ( parcours ) 
    242    { 
    243       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    244       { 
    245          writevardeclaration(parcours,fortranout,0,1); 
    246       } 
    247       parcours = parcours -> suiv; 
    248    } 
    249 } 
    250  
    251 void WriteFunctionDeclaration(int value) 
    252 { 
    253    listvar *parcours; 
    254  
    255    parcours = List_FunctionType_Var; 
    256    while ( parcours ) 
    257    { 
    258       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    259             strcasecmp(parcours->var->v_typevar,"") 
    260          ) 
    261       { 
    262          writevardeclaration(parcours,fortranout,value,1); 
    263       } 
    264       parcours = parcours -> suiv; 
    265    } 
    266 } 
    267  
    268 void WriteSubroutineDeclaration(int value) 
    269 { 
    270    listvar *parcours; 
    271  
    272    parcours = List_SubroutineDeclaration_Var; 
    273    while ( parcours ) 
    274    { 
    275       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    276            parcours->var->v_save == 0                                  && 
    277            parcours->var->v_pointerdeclare == 0                        && 
    278            parcours->var->v_VariableIsParameter == 0                   && 
    279            parcours->var->v_common == 0 
    280          ) 
    281       { 
    282          writevardeclaration(parcours,fortranout,value,1); 
    283  
    284       } 
    285       else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    286            parcours->var->v_save == 0                                  && 
    287            parcours->var->v_VariableIsParameter == 0                   && 
    288            parcours->var->v_common == 0 
    289               ) 
    290       { 
    291          writevardeclaration(parcours,fortranout,value,1); 
    292  
    293       } 
    294       parcours = parcours -> suiv; 
    295    } 
    296 } 
    297  
    298 void WriteArgumentDeclaration_beforecall() 
    299 { 
    300    int position; 
    301    listnom *neededparameter; 
    302    FILE *paramtoamr; 
    303    listvar *newvar; 
    304    char ligne[LONG_4C]; 
    305  
    306    fprintf(fortranout,"#include \"Param_BeforeCall_%s.h\" \n",subroutinename); 
    307    /*                                                                         */ 
    308    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename); 
    309    paramtoamr = associate (ligne); 
    310    /*                                                                         */ 
    311    neededparameter = (listnom * )NULL; 
    312    /*                                                                         */ 
    313    position = 1; 
    314    newvar = List_SubroutineArgument_Var; 
    315    while ( newvar ) 
    316    { 
    317       if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    318                        newvar->var->v_positioninblock == position 
    319          ) 
    320       { 
    321          position = position + 1; 
    322  
    323          writevardeclaration(newvar,fortranout,0,1); 
    324          neededparameter = writedeclarationintoamr(List_Parameter_Var, 
    325                    paramtoamr,newvar->var,newvar->var->v_subroutinename, 
    326                    neededparameter,subroutinename); 
    327  
    328          newvar = List_SubroutineArgument_Var; 
    329       } 
    330       else newvar = newvar -> suiv; 
    331    } 
    332    Save_Length(ligne,45); 
    333    fclose(paramtoamr); 
    334 } 
    335  
    336 void WriteArgumentDeclaration_Sort() 
    337 { 
    338    int position; 
    339    listvar *newvar; 
    340  
    341    /*                                                                         */ 
    342    position = 1; 
    343    newvar = List_SubroutineArgument_Var; 
    344    while ( newvar ) 
    345    { 
    346       if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    347                        newvar->var->v_positioninblock == position 
    348          ) 
    349       { 
    350          position = position + 1; 
    351  
    352          writevardeclaration(newvar,fortranout,1,1); 
    353          /*                                                                   */ 
    354          newvar = List_SubroutineArgument_Var; 
    355       } 
    356       else newvar = newvar -> suiv; 
    357    } 
    358    /*                                                                         */ 
    359    newvar = List_SubroutineArgument_Var; 
    360    while ( newvar ) 
    361    { 
    362       if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    363                        newvar->var->v_positioninblock == 0           && 
    364                        newvar->var->v_nbdim == 0 
    365          ) 
    366       { 
    367  
    368          writevardeclaration(newvar,fortranout,1,1); 
    369       } 
    370       newvar = newvar -> suiv; 
    371    } 
    372    /*                                                                         */ 
    373    newvar = List_SubroutineArgument_Var; 
    374    while ( newvar ) 
    375    { 
    376       if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    377                        newvar->var->v_positioninblock == 0           && 
    378                        newvar->var->v_nbdim != 0 
    379          ) 
    380       { 
    381          writevardeclaration(newvar,fortranout,1,1); 
    382       } 
    383       newvar = newvar -> suiv; 
    384    } 
    385 } 
    386  
    387 /******************************************************************************/ 
    388 /*                      writedeclarationintoamr                               */ 
    389 /******************************************************************************/ 
    390 /* This subroutine is used to write the declaration of parameters needed in   */ 
    391 /*    allocation subroutines creates in toamr.c                               */ 
    392 /******************************************************************************/ 
    393 /*                                                                            */ 
    394 /*                                                                            */ 
    395 /******************************************************************************/ 
    396 listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout, 
    397                               variable *var , char commonname[LONG_C], 
    398                            listnom *neededparameter, char name_common[LONG_C]) 
    399 { 
    400   listvar *newvar; 
    401   variable *v; 
    402   char ligne[LONG_4C]; 
     407  char ligne[LONG_M]; 
    403408  int changeval; 
    404409  int out; 
    405410  int writeit; 
    406411  listnom *parcours; 
    407   listnom *parcoursprec; 
    408  
    409   parcoursprec = (listnom * )NULL; 
    410412 
    411413  /* we should list the needed parameter                                      */ 
    412414  if ( !strcasecmp(name_common,commonname) ) 
    413      neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension, 
    414                                                                neededparameter); 
     415     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter); 
    415416  /*                                                                          */ 
    416417  parcours = neededparameter; 
    … …  
    422423     while ( newvar && out == 0 ) 
    423424     { 
    424       
     425 
    425426        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 
    426427        { 
    … …  
    443444     while ( newvar && out == 0 ) 
    444445     { 
    445         if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))         
     446        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 
    446447        { 
    447448           out=1; 
    … …  
    455456     parcours=parcours->suiv; 
    456457   } 
    457   /*                                                                          */ 
    458   tofich (fileout, "",1); 
    459458  parcours = neededparameter; 
    460459  while (parcours) 
    … …  
    482481//           v->v_allocatable = 0; 
    483482//        } 
    484         WriteBeginDeclaration(v,ligne,1); 
     483        WriteBeginDeclaration(v, ligne, 1); 
    485484        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    486         else WriteTableDeclaration(v,ligne,1); 
    487  
    488         tofich (fileout, ligne,1); 
     485        else WriteTableDeclaration(v, ligne, 1); 
     486 
     487        tofich(fileout, ligne, 1); 
    489488        if ( changeval == 1 ) 
    490489        { 
    … …  
    498497        { 
    499498           shouldincludempif = 0; 
    500            fprintf(fileout,"      include \'mpif.h\' \n"); 
     499           fprintf(fileout,"      include \'mpif.h\'\n"); 
    501500        } 
    502501     } 
    … …  
    524523  listvar *newvar; 
    525524  variable *v; 
    526   char ligne[LONG_4C]; 
    527  
    528   tofich (fileout, "",1); 
     525  char ligne[LONG_M]; 
     526 
     527//   tofich (fileout, "",1); 
    529528  newvar = deb_common; 
    530529 
    … …  
    533532     if ( newvar->var->v_nbdim == 0 && 
    534533          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  && 
    535 /*RB*/ 
    536            (newvar->var->v_pointerdeclare == 0  || !strcasecmp(newvar->var->v_typevar,"type"))   
    537 /*RBend*/ 
    538          ) 
     534           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) ) 
    539535     { 
    540536        v = newvar->var; 
    … …  
    565561  listvar *newvar; 
    566562  variable *v; 
    567   char ligne[LONG_4C]; 
     563  char ligne[LONG_M]; 
    568564  int changeval; 
    569565 
    570   tofich (fileout, "",1); 
    571566  newvar = deb_common; 
    572567  while (newvar) 
    573568  { 
    574   printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar); 
    575      if ( newvar->var->v_nbdim != 0                                 && 
    576           !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    577           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) 
    578         ) 
     569      v = newvar->var; 
     570//  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar); 
     571     if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) && 
     572          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) ) 
    579573     { 
    580574        changeval = 0; 
    581         v = newvar->var; 
    582575        if ( v->v_allocatable == 1) 
    583576        { 
    … …  
    595588        } 
    596589 
    597         WriteBeginDeclaration(v,ligne,1); 
    598         WriteTableDeclaration(v,ligne,1); 
     590        WriteBeginDeclaration(v, ligne, 1); 
     591        WriteTableDeclaration(v, ligne, 1); 
    599592        tofich (fileout, ligne,1); 
    600593        if ( changeval >= 1 ) v->v_allocatable = 1; 
    … …  
    606599} 
    607600 
    608  
    609601void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl) 
    610602{ 
    611 listvar *parcours; 
    612 listvar *parcours2; 
    613 listvar *parcours3; 
    614 int out; 
    615  
    616 if (insubroutinedeclare == 1) 
    617 { 
    618 parcours = listdecl; 
    619 while (parcours) 
    620 { 
    621 /* 
    622 parcours2 = List_SubroutineArgument_Var; 
    623 out = 0; 
    624 while (parcours2 && out == 0) 
    625 { 
    626 if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
    627  { 
    628  out = 1; 
    629  } 
    630 parcours2 = parcours2->suiv; 
    631 } 
    632 */ 
    633 out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var); 
    634 if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var); 
    635  
    636  
    637  
    638 if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var); 
    639 if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var); 
    640 if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var); 
    641  
    642 /* 
    643 parcours2 = List_Common_Var; 
    644 while (parcours2 && out == 0) 
    645 { 
    646 if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
    647  { 
    648  out = 1; 
    649  } 
    650 parcours2 = parcours2->suiv; 
    651 } 
    652 */ 
    653 //printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare); 
    654 if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)  
    655  
    656 { 
    657 writevardeclaration(parcours,fortranout,1,1); 
    658 } 
    659 //if (firstpass == 1 && out == 1) 
    660 if (firstpass == 1) 
    661   { 
    662   if (VariableIsParameter == 0 && SaveDeclare == 0) 
    663     { 
    664     List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var); 
    665     } 
    666   } 
    667 parcours = parcours->suiv; 
    668 } 
    669 } 
     603    listvar *parcours; 
     604    variable *v; 
     605    int out; 
     606 
     607    if ( insubroutinedeclare ) 
     608    { 
     609        parcours = listdecl; 
     610        while ( parcours ) 
     611        { 
     612            v = parcours->var; 
     613                          out = LookingForVariableInList(List_SubroutineArgument_Var, v); 
     614            if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var); 
     615            if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v); 
     616            if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v); 
     617            if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v); 
     618 
     619            if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) 
     620            { 
     621                WriteVarDeclaration(v, fortran_out, 1, 1); 
     622            } 
     623            if (firstpass == 1) 
     624            { 
     625                if (VariableIsParameter == 0 && SaveDeclare == 0) 
     626                { 
     627                    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v); 
     628                } 
     629            } 
     630            parcours = parcours->suiv; 
     631        } 
     632    } 
    670633} 
    671634 
    672635void ReWriteDataStatement_0(FILE * filout) 
    673636{ 
    674 listvar *parcours; 
    675 int out; 
    676 char ligne[LONG_C]; 
    677 char initialvalue[LONG_C]; 
    678  
    679 if (insubroutinedeclare == 1) 
    680 { 
    681 parcours = List_Data_Var_Cur ; 
    682 while (parcours) 
    683 { 
    684 out = VariableIsInListCommon(parcours,List_Common_Var); 
    685 if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var); 
    686  
    687 if (out == 0) 
    688 { 
    689 if (strncasecmp(parcours->var->v_initialvalue,"(/",2)) 
    690 { 
    691 strcpy(initialvalue,parcours->var->v_initialvalue); 
    692 } 
    693 else 
    694 { 
    695 strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4); 
    696 strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0"); 
    697 } 
    698 sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue); 
    699 tofich(filout,ligne,1); 
    700 } 
    701 parcours = parcours->suiv; 
    702 } 
    703 } 
    704 } 
     637    listvar *parcours; 
     638    int out; 
     639    char ligne[LONG_M]; 
     640    char initialvalue[LONG_M]; 
     641 
     642    if (insubroutinedeclare == 1) 
     643    { 
     644        parcours = List_Data_Var_Cur ; 
     645        while (parcours) 
     646        { 
     647            out = VariableIsInListCommon(parcours,List_Common_Var); 
     648            if (out)   break; 
     649 
     650            out = LookingForVariableInListGlobal(List_Global_Var,parcours->var); 
     651            if (out)   break; 
     652 
     653            if (strncasecmp(parcours->var->v_initialvalue,"(/",2)) 
     654            { 
     655                strcpy(initialvalue,parcours->var->v_initialvalue); 
     656            } 
     657            else 
     658            { 
     659                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4); 
     660                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0"); 
     661            } 
     662            sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue); 
     663            tofich(filout,ligne,1); 
     664 
     665            parcours = parcours->suiv; 
     666        } 
     667    } 
     668} 
Note: See TracChangeset for help on using the changeset viewer.