Changeset 10088 for vendors/AGRIF/CMEMS_2020/LIB/Writedeclarations.c
- Timestamp:
- 2018-09-05T15:35:32+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/CMEMS_2020/LIB/Writedeclarations.c
r5656 r10088 66 66 /* We should give the precision of the variable if it has been given */ 67 67 precision_given = 0; 68 68 69 if ( strcasecmp(v->v_precision,"") ) 69 70 { … … 128 129 { 129 130 strcat(line," = "); 130 strcat(line, v->v_initialvalue );131 strcat(line, v->v_initialvalue->n_name); 131 132 } 132 133 Save_Length(line, 45); … … 173 174 { 174 175 strcat(ligne," = "); 175 strcat(ligne,v->v_initialvalue );176 strcat(ligne,v->v_initialvalue->n_name); 176 177 } 177 178 Save_Length(ligne,45); … … 206 207 WriteTableDeclaration(v, ligne, value); 207 208 208 if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,""))209 if ( v->v_VariableIsParameter != 1 && v->v_initialvalue) 209 210 { 210 211 strcat(ligne," = "); 211 strcat(ligne,v->v_initialvalue );212 strcat(ligne,v->v_initialvalue->n_name); 212 213 } 213 214 tofich(filecommon, ligne, 1); … … 241 242 while ( parcours ) 242 243 { 244 if (!strcmp(parcours->var->v_typevar, "")) 245 { 246 /* Default type*/ 247 if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) 248 strcpy(parcours->var->v_typevar,"REAL"); 249 else strcpy(parcours->var->v_typevar,"INTEGER"); 250 } 243 251 if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) && 244 252 strcasecmp(parcours->var->v_typevar, "") ) … … 261 269 if ( !strcasecmp(v->v_subroutinename, subroutinename) && 262 270 (v->v_save == 0) && 263 (v->v_pointerdeclare == 0) &&264 271 (v->v_VariableIsParameter == 0) && 265 272 (v->v_common == 0) ) … … 285 292 listvar *parcours; 286 293 variable *v; 287 char ligne[LONG_M]; 288 294 char *ligne; 295 size_t line_length; 296 int res; 297 int global_check; 298 299 ligne = (char*) calloc(LONG_M, sizeof(char)); 300 line_length = LONG_M; 301 302 global_check = 0; 303 304 289 305 fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename); 290 306 … … 303 319 position++; 304 320 WriteVarDeclaration(v, fortran_out, 0, 1); 305 neededparameter= writedeclarationintoamr(List_Parameter_Var, paramtoamr,306 v, v->v_subroutinename, neededparameter, subroutinename);321 res = writedeclarationintoamr(List_Parameter_Var, paramtoamr, 322 v, v->v_subroutinename, &neededparameter, subroutinename, global_check); 307 323 parcours = List_SubroutineArgument_Var; 308 324 } 309 325 else parcours = parcours -> suiv; 310 326 } 311 Save_Length(ligne,45);312 327 313 328 // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module … … 317 332 if (isrecursive) sprintf(ligne," recursive subroutine Sub_Loop_%s(", subroutinename); 318 333 else sprintf(ligne," subroutine Sub_Loop_%s(", subroutinename); 319 WriteVariablelist_subloop( ligne);320 WriteVariablelist_subloop_Def( ligne);334 WriteVariablelist_subloop(&ligne,&line_length); 335 WriteVariablelist_subloop_Def(&ligne,&line_length); 321 336 strcat(ligne,")"); 322 Save_Length(ligne,45); 337 323 338 tofich(paramtoamr,ligne,1); 324 339 … … 353 368 354 369 parcours = List_SubroutineArgument_Var; 370 355 371 while ( parcours ) 356 372 { … … 399 415 /* */ 400 416 /******************************************************************************/ 401 listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,417 int writedeclarationintoamr (listvar * deb_common, FILE *fileout, 402 418 variable *var , const char *commonname, 403 listnom * neededparameter, const char *name_common)419 listnom **neededparameter, const char *name_common, int global_check) 404 420 { 405 421 listvar *newvar; … … 410 426 int writeit; 411 427 listnom *parcours; 428 listname *parcours_name_array; 429 int res; 430 431 res = 0; 412 432 413 433 /* we should list the needed parameter */ 434 414 435 if ( !strcasecmp(name_common,commonname) ) 415 neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter); 436 { 437 *neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,*neededparameter); 438 parcours_name_array = var->v_initialvalue_array; 439 while (parcours_name_array) 440 { 441 *neededparameter = DecomposeTheNameinlistnom(parcours_name_array->n_name,*neededparameter); 442 parcours_name_array=parcours_name_array->suiv; 443 } 444 } 445 416 446 /* */ 417 parcours = neededparameter; 447 parcours = *neededparameter; 448 418 449 while (parcours) 419 450 { … … 423 454 while ( newvar && out == 0 ) 424 455 { 425 426 if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 456 if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 427 457 { 428 458 out=1; 429 459 /* add the name to the list of needed parameter */ 430 neededparameter = DecomposeTheNameinlistnom( 431 newvar->var->v_initialvalue, 432 neededparameter ); 460 *neededparameter = DecomposeTheNameinlistnom( 461 newvar->var->v_initialvalue->n_name, 462 *neededparameter ); 463 } 464 else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename)) 465 { 466 out=1; 467 /* add the name to the list of needed parameter */ 468 *neededparameter = DecomposeTheNameinlistnom( 469 newvar->var->v_initialvalue->n_name, 470 *neededparameter ); 433 471 } 434 472 else newvar=newvar->suiv; … … 437 475 } 438 476 /* */ 439 parcours = neededparameter; 477 parcours = *neededparameter; 478 440 479 while (parcours) 441 480 { … … 444 483 while ( newvar && out == 0 ) 445 484 { 446 if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))485 if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) 447 486 { 448 487 out=1; 449 488 /* add the name to the list of needed parameter */ 450 neededparameter = DecomposeTheNameinlistnom( 451 newvar->var->v_initialvalue, 452 neededparameter ); 489 *neededparameter = DecomposeTheNameinlistnom( 490 newvar->var->v_initialvalue->n_name, 491 *neededparameter ); 492 } 493 else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename)) 494 { 495 out=1; 496 /* add the name to the list of needed parameter */ 497 *neededparameter = DecomposeTheNameinlistnom( 498 newvar->var->v_initialvalue->n_name, 499 *neededparameter ); 453 500 } 454 501 else newvar=newvar->suiv; … … 456 503 parcours=parcours->suiv; 457 504 } 458 parcours = neededparameter;505 parcours = *neededparameter; 459 506 while (parcours) 460 507 { … … 463 510 while ( newvar && writeit == 0 ) 464 511 { 465 if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&512 if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && 466 513 !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename) && parcours->o_val == 0 ) 514 { 515 writeit=1; 516 parcours->o_val = 1; 517 } 518 else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && 519 !strcasecmp(var->v_modulename,newvar->var->v_modulename) && parcours->o_val == 0 ) 467 520 { 468 521 writeit=1; … … 490 543 v->v_allocatable = 1; 491 544 } 545 res = 1; 492 546 } 493 547 else … … 503 557 } 504 558 Save_Length(ligne,45); 505 return neededparameter;559 return res; 506 560 } 507 561 … … 532 586 if ( newvar->var->v_nbdim == 0 && 533 587 !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 534 (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )588 (newvar->var->v_pointerdeclare >= 0 || !strcasecmp(newvar->var->v_typevar,"type")) ) 535 589 { 536 590 v = newvar->var; 537 538 591 WriteBeginDeclaration(v,ligne,1); 539 592 WriteScalarDeclaration(v,ligne); … … 570 623 // printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar); 571 624 if ( (v->v_nbdim != 0) && !strcasecmp(v->v_subroutinename, subroutinename) && 572 (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )625 (v->v_pointerdeclare >= 0 || !strcasecmp(v->v_typevar,"type")) ) 573 626 { 574 627 changeval = 0; … … 596 649 newvar = newvar->suiv; 597 650 } 651 598 652 Save_Length(ligne,45); 599 653 } … … 619 673 if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) 620 674 { 675 676 /* The type may has not been given if the variable was only declared with dimension */ 677 678 if ( !strcasecmp(v->v_typevar,"") ) 679 { 680 if ( IsVariableReal(v->v_nomvar) == 1 ) 681 strcpy(v->v_typevar,"REAL"); 682 else strcpy(v->v_typevar,"INTEGER"); 683 v->v_catvar = get_cat_var(v); 684 } 685 621 686 WriteVarDeclaration(v, fortran_out, 1, 1); 622 687 } … … 639 704 char ligne[LONG_M]; 640 705 char initialvalue[LONG_M]; 641 706 listname *parcours_name; 707 642 708 if (insubroutinedeclare == 1) 643 709 { … … 651 717 if (out) break; 652 718 653 if (strncasecmp(parcours->var->v_initialvalue,"(/",2)) 719 strcpy(initialvalue,""); 720 parcours_name = parcours->var->v_initialvalue; 721 while (parcours_name) 654 722 { 655 strcpy(initialvalue,parcours->var->v_initialvalue); 723 if (strncasecmp(parcours_name->n_name,"(/",2)) 724 { 725 strcat(initialvalue,parcours_name->n_name); 726 if (parcours_name->suiv) 727 { 728 strcat(initialvalue,","); 729 } 656 730 } 657 731 else 658 732 { 659 strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4); 660 strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0"); 733 printf("A TRAITER DANS REWRITEDATA STATEMETN "); 734 exit(1); 735 strncpy(initialvalue,&parcours_name->n_name[2],strlen(parcours_name->n_name)-4); 736 strcpy(&initialvalue[strlen(parcours_name->n_name)-4],"\0"); 737 } 738 parcours_name=parcours_name->suiv; 661 739 } 662 740 sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue); 663 741 tofich(filout,ligne,1); 664 742 665 743 parcours = parcours->suiv; 666 744 }
Note: See TracChangeset
for help on using the changeset viewer.