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

Ignore:
Timestamp:
2008-09-24T15:05:20+02:00 (16 years ago)
Author:
rblod
Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/LIB/Writedeclarations.c

    r774 r1200  
    5050/*                                                                            */ 
    5151/******************************************************************************/ 
    52 void WriteBeginDeclaration(variable *v,char ligne[LONG_4C]) 
     52void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility) 
    5353{ 
    5454  char tmpligne[LONG_4C]; 
    … …  
    5959     printf("          is unknown. CONV should define a type\n"); 
    6060  } 
     61   
    6162  sprintf (ligne, "%s", v->v_typevar); 
    6263  if ( v->v_c_star == 1 ) strcat(ligne,"*"); 
     64   
    6365  /* We should give the precision of the variable if it has been given        */ 
    6466  if ( strcasecmp(v->v_precision,"") ) 
    … …  
    6870     strcat(ligne,tmpligne); 
    6971  } 
     72   
    7073  if (strcasecmp(v->v_dimchar,"")) 
    7174  { 
    … …  
    7477     strcat(ligne,tmpligne); 
    7578  } 
     79   
    7680  if ( strcasecmp(v->v_nameinttypename,"") ) 
    7781  { 
    … …  
    8791  } 
    8892  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER"); 
     93  if (visibility == 1) 
     94  { 
    8995  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC"); 
    9096  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE"); 
     97  } 
    9198  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL"); 
    9299  if ( v->v_allocatable         == 1 && 
    93        v->v_save                == 0 ) strcat(ligne,", ALLOCATABLE"); 
     100       v->v_save                == 0 ) 
     101       {strcat(ligne,", ALLOCATABLE"); 
     102       } 
    94103  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL"); 
    95104  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER"); 
    … …  
    141150 
    142151  strcat (ligne, ", Dimension("); 
     152 
    143153  if ( v->v_dimensiongiven == 1 && tmpok == 1 ) 
     154  { 
    144155                                         strcat(ligne,v->v_readedlistdimension); 
     156                                         } 
    145157  if ( v->v_dimensiongiven == 1 && tmpok == 0 ) 
    146158  { 
    147159     strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    148160                                  (v->v_readedlistdimension,List_Global_Var,0)); 
    149      if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
    150      { 
    151         strcpy(newname,""); 
     161 
     162     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
     163 
    152164        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    153                                  (v->v_readedlistdimension,List_Common_Var,0)); 
     165                                 (newname,List_Common_Var,0)); 
     166 
     167     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);  
     168      
     169        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
     170                              (newname,List_ModuleUsed_Var,0)); 
    154171        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    155      } 
    156      if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
    157      { 
    158         strcpy(newname,""); 
    159         /* la liste des use de cette subroutine                               */ 
    160         strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    161                               (v->v_readedlistdimension,List_ModuleUsed_Var,0)); 
    162         if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    163      } 
     172 
    164173     Save_Length(newname,47); 
    165174     strcat(ligne,newname); 
    … …  
    190199/*                                                                            */ 
    191200/******************************************************************************/ 
    192 void writevardeclaration (listvar * var_record, FILE *fileout, int value) 
     201void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility) 
    193202{ 
    194203  FILE *filecommon; 
    … …  
    199208  filecommon=fileout; 
    200209  newvar = var_record; 
    201  
     210   
    202211  if ( newvar->var->v_save == 0 || inmodulemeet == 0 ) 
    203212  { 
    204213     v = newvar->var; 
    205      WriteBeginDeclaration(v,ligne); 
     214      
     215     WriteBeginDeclaration(v,ligne,visibility); 
     216 
    206217     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    207218     else WriteTableDeclaration(v,ligne,value); 
    … …  
    212223        strcat(ligne,v->v_initialvalue); 
    213224     } 
     225      
    214226     tofich (filecommon, ligne,1); 
    215227  } 
    216228  Save_Length(ligne,45); 
     229   
    217230} 
    218231 
    … …  
    227240      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    228241      { 
    229          writevardeclaration(parcours,fortranout,0); 
     242         writevardeclaration(parcours,fortranout,0,1); 
    230243      } 
    231244      parcours = parcours -> suiv; 
    … …  
    233246} 
    234247 
    235 void WriteFunctionDeclaration() 
     248void WriteFunctionDeclaration(int value) 
    236249{ 
    237250   listvar *parcours; 
    … …  
    244257         ) 
    245258      { 
    246          writevardeclaration(parcours,fortranout,0); 
     259         writevardeclaration(parcours,fortranout,value,1); 
    247260      } 
    248261      parcours = parcours -> suiv; 
    … …  
    259272      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    260273           parcours->var->v_save == 0                                  && 
    261            parcours->var->v_allocatable == 0                           && 
     274          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    262275           parcours->var->v_pointerdeclare == 0                        && 
    263276           parcours->var->v_VariableIsParameter == 0                   && 
    … …  
    265278         ) 
    266279      { 
    267          writevardeclaration(parcours,fortranout,value); 
     280         writevardeclaration(parcours,fortranout,value,1); 
     281 
    268282      } 
    269283      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    … …  
    273287              ) 
    274288      { 
    275          writevardeclaration(parcours,fortranout,value); 
     289         writevardeclaration(parcours,fortranout,value,1); 
     290 
    276291      } 
    277292      parcours = parcours -> suiv; 
    … …  
    303318      { 
    304319         position = position + 1; 
    305          writevardeclaration(newvar,fortranout,0); 
     320 
     321         writevardeclaration(newvar,fortranout,0,1); 
    306322         neededparameter = writedeclarationintoamr(List_Parameter_Var, 
    307323                   paramtoamr,newvar->var,newvar->var->v_subroutinename, 
    … …  
    331347      { 
    332348         position = position + 1; 
    333          writevardeclaration(newvar,fortranout,1); 
     349 
     350         writevardeclaration(newvar,fortranout,1,1); 
    334351         /*                                                                   */ 
    335352         newvar = List_SubroutineArgument_Var; 
    … …  
    346363         ) 
    347364      { 
    348          writevardeclaration(newvar,fortranout,1); 
     365 
     366         writevardeclaration(newvar,fortranout,1,1); 
    349367      } 
    350368      newvar = newvar -> suiv; 
    … …  
    359377         ) 
    360378      { 
    361          writevardeclaration(newvar,fortranout,1); 
     379         writevardeclaration(newvar,fortranout,1,1); 
    362380      } 
    363381      newvar = newvar -> suiv; 
    … …  
    454472        changeval = 0; 
    455473        v = newvar->var; 
    456         if ( v->v_allocatable == 1 ) 
     474        if ( v->v_allocatable == 1 && strcasecmp(v->v_typevar,"type") ) 
    457475        { 
    458476           changeval = 1; 
    459477           v->v_allocatable = 0; 
    460478        } 
    461         WriteBeginDeclaration(v,ligne); 
     479        WriteBeginDeclaration(v,ligne,1); 
    462480        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    463481        else WriteTableDeclaration(v,ligne,1); 
    … …  
    509527     if ( newvar->var->v_nbdim == 0 && 
    510528          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  && 
    511            newvar->var->v_allocatable == 0                           && 
     529          (newvar->var->v_allocatable == 0  || !strcasecmp(newvar->var->v_typevar,"type"))      && 
    512530           newvar->var->v_pointerdeclare == 0 
    513531         ) 
    … …  
    515533        v = newvar->var; 
    516534 
    517         WriteBeginDeclaration(v,ligne); 
     535        WriteBeginDeclaration(v,ligne,1); 
    518536        WriteScalarDeclaration(v,ligne); 
    519537        tofich (fileout, ligne,1); 
    … …  
    549567     if ( newvar->var->v_nbdim != 0                                 && 
    550568          !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    551           newvar->var->v_allocatable == 0                           && 
     569          (newvar->var->v_allocatable == 0  || !strcasecmp(newvar->var->v_typevar,"type"))      && 
    552570          newvar->var->v_pointerdeclare == 0 
    553571        ) 
    … …  
    555573        changeval = 0; 
    556574        v = newvar->var; 
    557         if ( v->v_allocatable == 1 ) 
     575        if ( v->v_allocatable == 1) 
    558576        { 
     577          if (strcasecmp(v->v_typevar,"type")) 
     578           { 
    559579           changeval = 1; 
    560580           v->v_allocatable = 0; 
     581           } 
     582          else 
     583           { 
     584           changeval = 2; 
     585           v->v_allocatable = 0; 
     586           v->v_pointerdeclare = 1; 
     587           } 
    561588        } 
    562         WriteBeginDeclaration(v,ligne); 
     589 
     590        WriteBeginDeclaration(v,ligne,1); 
    563591        WriteTableDeclaration(v,ligne,1); 
    564592        tofich (fileout, ligne,1); 
    565         if ( changeval == 1 ) v->v_allocatable = 1; 
     593        if ( changeval >= 1 ) v->v_allocatable = 1; 
     594        if ( changeval == 2 ) v->v_pointerdeclare = 0; 
    566595     } 
    567596     newvar = newvar->suiv; 
    … …  
    569598  Save_Length(ligne,45); 
    570599} 
     600 
     601 
     602void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl) 
     603{ 
     604listvar *parcours; 
     605listvar *parcours2; 
     606listvar *parcours3; 
     607int out; 
     608 
     609if (insubroutinedeclare == 1) 
     610{ 
     611parcours = listdecl; 
     612while (parcours) 
     613{ 
     614/* 
     615parcours2 = List_SubroutineArgument_Var; 
     616out = 0; 
     617while (parcours2 && out == 0) 
     618{ 
     619if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
     620 { 
     621 out = 1; 
     622 } 
     623parcours2 = parcours2->suiv; 
     624} 
     625*/ 
     626out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var); 
     627if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var); 
     628if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var); 
     629if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var); 
     630 
     631/* 
     632parcours2 = List_Common_Var; 
     633while (parcours2 && out == 0) 
     634{ 
     635if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
     636 { 
     637 out = 1; 
     638 } 
     639parcours2 = parcours2->suiv; 
     640} 
     641*/ 
     642//printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare); 
     643if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)  
     644 
     645{ 
     646writevardeclaration(parcours,fortranout,1,1); 
     647} 
     648//if (firstpass == 1 && out == 1) 
     649if (firstpass == 1) 
     650  { 
     651  if (VariableIsParameter == 0 && SaveDeclare == 0) 
     652    { 
     653    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var); 
     654    } 
     655  } 
     656parcours = parcours->suiv; 
     657} 
     658} 
     659} 
Note: See TracChangeset for help on using the changeset viewer.