Changeset 6379 for branches/UKMO/dev_r5518_debug_GO6CICE_pkg/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
- Timestamp:
- 2016-03-10T14:49:10+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_debug_GO6CICE_pkg/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
r3294 r6379 50 50 /* */ 51 51 /******************************************************************************/ 52 void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility) 53 { 54 char tmpligne[LONG_4C]; 52 void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility) 53 { 54 char tmpligne[LONG_M]; 55 int precision_given ; 55 56 56 57 if ( !strcasecmp(v->v_typevar,"") ) 57 58 { 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(li gne,"*");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 65 66 /* We should give the precision of the variable if it has been given */ 67 precision_given = 0; 66 68 if ( strcasecmp(v->v_precision,"") ) 67 69 { 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 73 76 if (strcasecmp(v->v_dimchar,"")) 74 77 { 75 78 sprintf(tmpligne,"(%s)",v->v_dimchar); 76 Save_Length(tmpligne, 49);77 strcat(li gne,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,"") )) 81 84 { 82 85 sprintf(tmpligne,"*%s",v->v_nameinttypename); 83 Save_Length(tmpligne, 49);84 strcat(li gne,tmpligne);86 Save_Length(tmpligne, 49); 87 strcat(line,tmpligne); 85 88 } 86 89 if (strcasecmp (v->v_IntentSpec, "")) 87 90 { 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); 108 107 } 109 108 … … 120 119 /* */ 121 120 /******************************************************************************/ 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 121 void 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 } 136 134 137 135 /******************************************************************************/ … … 147 145 /* */ 148 146 /******************************************************************************/ 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)); 147 void 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)); 173 157 if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 174 158 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 */ 193 182 /******************************************************************************/ 194 183 /* This subroutine is used to write the initial declaration in the file */ … … 201 190 /* */ 202 191 /******************************************************************************/ 203 void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility)192 void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility ) 204 193 { 205 194 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 221 void 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 236 void 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 252 void 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 280 void 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 349 void 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 /******************************************************************************/ 401 listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout, 402 variable *var , const char *commonname, 403 listnom *neededparameter, const char *name_common) 404 { 206 405 listvar *newvar; 207 406 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]; 403 408 int changeval; 404 409 int out; 405 410 int writeit; 406 411 listnom *parcours; 407 listnom *parcoursprec;408 409 parcoursprec = (listnom * )NULL;410 412 411 413 /* we should list the needed parameter */ 412 414 if ( !strcasecmp(name_common,commonname) ) 413 neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension, 414 neededparameter); 415 neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter); 415 416 /* */ 416 417 parcours = neededparameter; … … 422 423 while ( newvar && out == 0 ) 423 424 { 424 425 425 426 if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 426 427 { … … 443 444 while ( newvar && out == 0 ) 444 445 { 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)) 446 447 { 447 448 out=1; … … 455 456 parcours=parcours->suiv; 456 457 } 457 /* */458 tofich (fileout, "",1);459 458 parcours = neededparameter; 460 459 while (parcours) … … 482 481 // v->v_allocatable = 0; 483 482 // } 484 WriteBeginDeclaration(v, ligne,1);483 WriteBeginDeclaration(v, ligne, 1); 485 484 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); 489 488 if ( changeval == 1 ) 490 489 { … … 498 497 { 499 498 shouldincludempif = 0; 500 fprintf(fileout," include \'mpif.h\' 499 fprintf(fileout," include \'mpif.h\'\n"); 501 500 } 502 501 } … … 524 523 listvar *newvar; 525 524 variable *v; 526 char ligne[LONG_ 4C];527 528 tofich (fileout, "",1);525 char ligne[LONG_M]; 526 527 // tofich (fileout, "",1); 529 528 newvar = deb_common; 530 529 … … 533 532 if ( newvar->var->v_nbdim == 0 && 534 533 !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")) ) 539 535 { 540 536 v = newvar->var; … … 565 561 listvar *newvar; 566 562 variable *v; 567 char ligne[LONG_ 4C];563 char ligne[LONG_M]; 568 564 int changeval; 569 565 570 tofich (fileout, "",1);571 566 newvar = deb_common; 572 567 while (newvar) 573 568 { 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")) ) 579 573 { 580 574 changeval = 0; 581 v = newvar->var;582 575 if ( v->v_allocatable == 1) 583 576 { … … 595 588 } 596 589 597 WriteBeginDeclaration(v, ligne,1);598 WriteTableDeclaration(v, ligne,1);590 WriteBeginDeclaration(v, ligne, 1); 591 WriteTableDeclaration(v, ligne, 1); 599 592 tofich (fileout, ligne,1); 600 593 if ( changeval >= 1 ) v->v_allocatable = 1; … … 606 599 } 607 600 608 609 601 void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl) 610 602 { 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 } 670 633 } 671 634 672 635 void ReWriteDataStatement_0(FILE * filout) 673 636 { 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.