Changeset 4777 for vendors/AGRIF/current/LIB/UtilAgrif.c
- Timestamp:
- 2014-09-19T15:51:42+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/current/LIB/UtilAgrif.c
r2671 r4777 45 45 /* */ 46 46 /******************************************************************************/ 47 int Vartonumber(c har *tokname)47 int Vartonumber(const char *tokname) 48 48 { 49 49 int agrifintheword; … … 68 68 else if ( !strcasecmp(tokname,"Agrif_Set_restore") ) agrifintheword = 1; 69 69 else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1; 70 else if ( !strcasecmp(tokname,"agrif_init_grids") ) agrifintheword = 1; 71 else if ( !strcasecmp(tokname,"agrif_step") ) agrifintheword = 1; 70 else if ( !strcasecmp(tokname,"Agrif_init_grids") ) agrifintheword = 1; 71 else if ( !strcasecmp(tokname,"Agrif_step") ) agrifintheword = 1; 72 /**************************************************/ 73 /* adding specific adjoint agrif subroutine names */ 74 /**************************************************/ 75 else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj") ) agrifintheword = 1; 76 else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1; 72 77 73 78 return agrifintheword; … … 85 90 /* */ 86 91 /******************************************************************************/ 87 int Agrif_in_Tok_NAME(char *tokname) 88 { 89 int agrifintheword; 90 91 if ( strncasecmp(tokname,"Agrif_",6) == 0 ) agrifintheword = 1; 92 else agrifintheword = 0; 93 94 return agrifintheword; 92 int Agrif_in_Tok_NAME(const char *tokname) 93 { 94 return ( strncasecmp(tokname,"Agrif_",6) == 0 ); 95 95 } 96 96 … … 104 104 /* */ 105 105 /******************************************************************************/ 106 void ModifyTheVariableName_0(char *ident, int lengthname) 107 { 108 listvar *newvar; 109 int out; 110 111 printf("ICI ident = %s\n",ident); 112 113 if ( firstpass == 0 ) 114 { 115 newvar = List_Global_Var; 116 out=0; 117 while ( newvar && out == 0 ) 118 { 119 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 120 else newvar=newvar->suiv; 121 } 122 printf("out1 = %d\n",out); 123 if ( out == 0 ) 124 { 125 newvar = List_ModuleUsed_Var; 126 while ( newvar && out == 0 ) 127 { 106 void ModifyTheVariableName_0(const char *ident, int lengthname) 107 { 108 listvar *newvar; 109 int out; 110 111 if ( firstpass ) return; 112 113 newvar = List_Global_Var; 114 out = 0; 115 while ( newvar && out == 0 ) 116 { 117 if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1; 118 else newvar = newvar->suiv; 119 } 120 if ( out == 0 ) 121 { 122 newvar = List_ModuleUsed_Var; 123 while ( newvar && out == 0 ) 124 { 128 125 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 129 else newvar =newvar->suiv;130 131 132 if (out == 1&& !strcasecmp(newvar->var->v_typevar,"type")) return;133 134 135 136 137 138 126 else newvar = newvar->suiv; 127 } 128 } 129 if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return; 130 131 if ( out == 0 ) 132 { 133 newvar = List_Common_Var; 134 while ( newvar && out == 0 ) 135 { 139 136 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 140 else newvar=newvar->suiv; 141 } 142 } 143 144 if ( out == 0 ) 145 { 146 newvar = List_ModuleUsedInModuleUsed_Var; 147 while ( newvar && out == 0 ) 148 { 137 else newvar = newvar->suiv; 138 } 139 } 140 if ( out == 0 ) 141 { 142 newvar = List_ModuleUsedInModuleUsed_Var; 143 while ( newvar && out == 0 ) 144 { 149 145 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 150 else newvar=newvar->suiv; 151 } 152 } 153 154 if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 155 { 156 printf("ICIC3\n"); 157 /* remove the variable */ 158 RemoveWordCUR_0(fortranout,(long)(-lengthname), 159 lengthname); 160 fseek(fortranout,(long)(-lengthname),SEEK_CUR); 161 /* then write the new name */ 162 if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 163 fprintf(fortranout,"%d",newvar->var->v_indicetabvars); 164 else 165 { 146 else newvar = newvar->suiv; 147 } 148 } 149 if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 150 { 151 // remove the variable 152 RemoveWordCUR_0(fortran_out,lengthname); 153 // then write the new name 154 if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 155 fprintf(fortran_out,"%d",newvar->var->v_indicetabvars); 156 else 157 { 166 158 if ( retour77 == 0 ) 167 { 168 fprintf(fortranout," Agrif_tabvars & \n "); 169 } 159 fprintf(fortran_out,"Agrif_%s & \n ", tabvarsname(newvar->var)); 170 160 else 171 161 { 172 fprintf(fortran out,"Agrif_tabvars");173 fprintf(fortran out," \n & ");162 fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var)); 163 fprintf(fortran_out," \n & "); 174 164 } 175 fprintf(fortranout,"%s", 176 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 177 colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 178 } 179 } 180 else 181 { 182 /* we should look in the List_ModuleUsed_Var */ 183 if ( inagrifcallargument != 1 ) 184 { 165 fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 166 } 167 } 168 else 169 { 170 // we should look in the List_ModuleUsed_Var 171 if ( inagrifcallargument != 1 ) 172 { 185 173 newvar = List_ModuleUsed_Var; 186 174 while ( newvar && out == 0 ) 187 175 { 188 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;189 else newvar=newvar->suiv;176 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 177 else newvar = newvar->suiv; 190 178 } 191 if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type"))179 if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type")) 192 180 { 193 printf("ICICIC4 %s\n",newvar->var->v_typevar); 194 /* remove the variable */ 195 RemoveWordCUR_0(fortranout,(long)(-lengthname), 196 lengthname); 197 fseek(fortranout,(long)(-lengthname),SEEK_CUR); 198 /* then write the new name */ 199 if ( retour77 == 0 ) 200 { 201 fprintf(fortranout," Agrif_tabvars & \n "); 202 } 203 else 204 { 205 fprintf(fortranout," \n & Agrif_tabvars"); 206 } 207 fprintf(fortranout,"%s", 208 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 209 colnum = strlen( 210 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 181 // remove the variable 182 RemoveWordCUR_0(fortran_out,lengthname); 183 // then write the new name 184 if ( retour77 == 0 ) 185 fprintf(fortran_out,"Agrif_%s & \n ",tabvarsname(newvar->var)); 186 else 187 { 188 fprintf(fortran_out," \n &Agrif_%s",tabvarsname(newvar->var)); 189 } 190 fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 211 191 } 212 } 213 } 214 } 215 } 216 217 /******************************************************************************/ 218 /* ModifyTheVariableName_0 */ 219 /******************************************************************************/ 220 /* Firstpass 0 */ 221 /******************************************************************************/ 222 /* */ 223 /* Agrif_<toto>(variable) ====> Agrif_<toto>(variable) */ 224 /* */ 225 /******************************************************************************/ 226 void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident) 227 { 228 listvar *newvar; 229 int out; 230 231 if ( firstpass == 0 ) 232 { 233 newvar = List_Global_Var; 234 out=0; 235 while ( newvar && out == 0 ) 236 { 237 if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 238 else newvar=newvar->suiv; 239 } 240 241 if ( out == 0 ) 242 { 243 newvar = List_ModuleUsed_Var; 244 while ( newvar && out == 0 ) 245 { 246 if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 247 else newvar=newvar->suiv; 248 } 249 } 250 if ( out == 0 ) 251 { 252 newvar = List_Common_Var; 253 while ( newvar && out == 0 ) 254 { 255 if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 256 else newvar=newvar->suiv; 257 } 258 } 259 260 if ( out == 0 ) 261 { 262 newvar = List_ModuleUsedInModuleUsed_Var; 263 while ( newvar && out == 0 ) 264 { 265 if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 266 else newvar=newvar->suiv; 267 } 268 } 269 270 if ( out == 1 ) 271 { 272 /* remove the variable */ 273 RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 274 strlen(ident)); 275 fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 276 /* then write the new name */ 277 if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 278 fprintf(fortranout,"%d",newvar->var->v_indicetabvars); 279 else 280 { 281 if ( retour77 == 0 ) 282 { 283 fprintf(fortranout," Agrif_tabvars & \n "); 284 } 285 else 286 { 287 fprintf(fortranout,"Agrif_tabvars"); 288 fprintf(fortranout," \n & "); 289 } 290 fprintf(fortranout,"%s", 291 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 292 colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 293 } 294 } 295 else 296 { 297 /* we should look in the List_ModuleUsed_Var */ 298 if ( inagrifcallargument != 1 ) 299 { 300 newvar = List_ModuleUsed_Var; 301 while ( newvar && out == 0 ) 302 { 303 if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 304 else newvar=newvar->suiv; 305 } 306 if ( out == 1 ) 307 { 308 /* remove the variable */ 309 RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 310 strlen(ident)); 311 fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 312 /* then write the new name */ 313 if ( retour77 == 0 ) 314 { 315 fprintf(fortranout," Agrif_tabvars & \n "); 316 } 317 else 318 { 319 fprintf(fortranout," \n & Agrif_tabvars"); 320 } 321 fprintf(fortranout,"%s", 322 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 323 colnum = strlen( 324 vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 325 } 326 } 327 } 328 } 329 } 330 331 192 } 193 } 194 } 332 195 333 196 /******************************************************************************/ … … 348 211 /* */ 349 212 /******************************************************************************/ 350 void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod) 351 { 352 listnom *listnomtmp; 353 listnom *parcours; 354 355 if ( firstpass == 1 ) 356 { 357 if ( !List_SubroutineWhereAgrifUsed ) 358 { 359 listnomtmp=(listnom *)malloc(sizeof(listnom)); 360 strcpy(listnomtmp->o_nom,sub); 361 Save_Length(sub,23); 362 strcpy(listnomtmp->o_module,mod); 363 Save_Length(mod,24); 364 listnomtmp->suiv = NULL; 365 List_SubroutineWhereAgrifUsed = listnomtmp; 366 } 367 else 368 { 369 parcours = List_SubroutineWhereAgrifUsed; 370 while ( parcours && strcasecmp(parcours->o_nom,sub) ) 371 { 372 parcours = parcours->suiv; 373 } 374 if ( !parcours ) 375 { 376 listnomtmp=(listnom *)malloc(sizeof(listnom)); 377 strcpy(listnomtmp->o_nom,sub); 378 Save_Length(sub,23); 379 strcpy(listnomtmp->o_module,mod); 380 Save_Length(mod,24); 381 listnomtmp->suiv = List_SubroutineWhereAgrifUsed; 382 List_SubroutineWhereAgrifUsed = listnomtmp; 383 } 384 } 385 } 213 void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod) 214 { 215 listnom *listnomtmp; 216 listnom *parcours; 217 218 if ( firstpass == 1 ) 219 { 220 if ( !List_SubroutineWhereAgrifUsed ) 221 { 222 listnomtmp = (listnom*) calloc(1, sizeof(listnom)); 223 strcpy(listnomtmp->o_nom, sub); 224 strcpy(listnomtmp->o_module, mod); 225 listnomtmp->suiv = NULL; 226 List_SubroutineWhereAgrifUsed = listnomtmp; 227 } 228 else 229 { 230 parcours = List_SubroutineWhereAgrifUsed; 231 while ( parcours && strcasecmp(parcours->o_nom,sub) ) 232 { 233 parcours = parcours->suiv; 234 } 235 if ( !parcours ) 236 { 237 listnomtmp = (listnom*) calloc(1, sizeof(listnom)); 238 strcpy(listnomtmp->o_nom, sub); 239 strcpy(listnomtmp->o_module, mod); 240 listnomtmp->suiv = List_SubroutineWhereAgrifUsed; 241 List_SubroutineWhereAgrifUsed = listnomtmp; 242 } 243 } 244 } 386 245 } 387 246 … … 411 270 parcours = List_SubroutineWhereAgrifUsed; 412 271 while ( parcours && strcasecmp(parcours->o_nom,subroutinename) ) 413 parcours = parcours -> suiv; 272 { 273 parcours = parcours -> suiv; 274 } 414 275 if ( parcours && parcours->o_val != 0 ) 415 fprintf(fileout,"\n USE Agrif_Util \n"); 276 fprintf(fileout,"\n use Agrif_Util\n"); 277 else 278 fprintf(fileout,"\n use Agrif_Types, only : Agrif_tabvars\n"); 416 279 } 417 280 } … … 419 282 void AddUseAgrifUtilBeforeCall_0(FILE *fileout) 420 283 { 421 listusemodule *parcours; 422 423 int out; 424 425 if ( firstpass == 0 ) 426 { 427 parcours = List_NameOfModuleUsed; 428 out = 0 ; 429 while ( parcours && out == 0 ) 430 { 431 if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util") && 432 !strcasecmp(parcours->u_modulename,curmodulename) && 433 !strcasecmp(parcours->u_cursubroutine,subroutinename) 434 ) out = 1; 435 else parcours = parcours->suiv; 436 } 437 if ( out == 0 ) 438 { 439 fprintf(fileout,"\n USE Agrif_Util \n"); 440 } 441 } 284 listusemodule *parcours; 285 286 int out; 287 288 if ( firstpass == 0 ) 289 { 290 parcours = List_NameOfModuleUsed; 291 out = 0 ; 292 while ( parcours && out == 0 ) 293 { 294 if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util") && 295 !strcasecmp(parcours->u_modulename, curmodulename) && 296 !strcasecmp(parcours->u_cursubroutine, subroutinename) ) 297 out = 1; 298 else 299 parcours = parcours->suiv; 300 } 301 if ( out == 0 ) 302 { 303 fprintf(fileout,"\n use Agrif_Util\n"); 304 } 305 } 442 306 } 443 307 … … 451 315 /* */ 452 316 /******************************************************************************/ 453 void NotifyAgrifFunction_0(char *ident) 454 { 455 if ( firstpass == 0 ) 456 { 457 if ( !strcasecmp(ident,"Agrif_parent") ) 458 { 459 InAgrifParentDef = 1; 460 pos_curagrifparent = setposcur()-12; 461 } 462 else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 463 { 464 InAgrifParentDef = 2; 465 pos_curagrifparent = setposcur()-21; 466 } 467 else if ( !strcasecmp(ident,"Agrif_Rhox") ) 468 { 469 InAgrifParentDef = 3; 470 pos_curagrifparent = setposcur()-10; 471 } 472 else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 473 { 474 InAgrifParentDef = 4; 475 pos_curagrifparent = setposcur()-17; 476 } 477 else if ( !strcasecmp(ident,"Agrif_IRhox") ) 478 { 479 InAgrifParentDef = 5; 480 pos_curagrifparent = setposcur()-11; 481 } 482 else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 483 { 484 InAgrifParentDef = 6; 485 pos_curagrifparent = setposcur()-18; 486 } 487 else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 488 { 489 InAgrifParentDef = 7; 490 pos_curagrifparent = setposcur()-10; 491 } 492 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 493 { 494 InAgrifParentDef = 8; 495 pos_curagrifparent = setposcur()-17; 496 } 497 else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 498 { 499 InAgrifParentDef = 9; 500 pos_curagrifparent = setposcur()-11; 501 } 502 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 503 { 504 InAgrifParentDef = 10; 505 pos_curagrifparent = setposcur()-18; 506 } 507 else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 508 { 509 InAgrifParentDef = 11; 510 pos_curagrifparent = setposcur()-10; 511 } 512 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 513 { 514 InAgrifParentDef = 12; 515 pos_curagrifparent = setposcur()-17; 516 } 517 else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 518 { 519 InAgrifParentDef = 13; 520 pos_curagrifparent = setposcur()-11; 521 } 522 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 523 { 524 InAgrifParentDef = 14; 525 pos_curagrifparent = setposcur()-18; 526 } 527 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 528 { 529 InAgrifParentDef = 15; 530 pos_curagrifparent = setposcur()-23; 531 } 532 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 533 { 534 InAgrifParentDef = 16; 535 pos_curagrifparent = setposcur()-23; 536 } 537 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 538 { 539 InAgrifParentDef = 17; 540 pos_curagrifparent = setposcur()-23; 541 } 542 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 543 { 544 InAgrifParentDef = 18; 545 pos_curagrifparent = setposcur()-26; 546 } 547 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 548 { 549 InAgrifParentDef = 19; 550 pos_curagrifparent = setposcur()-26; 551 } 552 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 553 { 554 InAgrifParentDef = 20; 555 pos_curagrifparent = setposcur()-26; 556 } 557 else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 558 { 559 InAgrifParentDef = 21; 560 pos_curagrifparent = setposcur()-19; 561 } 562 else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 563 { 564 InAgrifParentDef = 22; 565 pos_curagrifparent = setposcur()-17; 566 } 567 else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 568 { 569 InAgrifParentDef = 23; 570 pos_curagrifparent = setposcur()-15; 571 } 572 else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 573 { 574 InAgrifParentDef = 24; 575 pos_curagrifparent = setposcur()-15; 576 } 577 else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 578 { 579 InAgrifParentDef = 25; 580 pos_curagrifparent = setposcur()-15; 581 } 582 else if ( !strcasecmp(ident,"Agrif_Iz") ) 583 { 584 InAgrifParentDef = 26; 585 pos_curagrifparent = setposcur()-8; 586 } 587 else if ( !strcasecmp(ident,"Agrif_Iy") ) 588 { 589 InAgrifParentDef = 27; 590 pos_curagrifparent = setposcur()-8; 591 } 592 else if ( !strcasecmp(ident,"Agrif_Ix") ) 593 { 594 InAgrifParentDef = 28; 595 pos_curagrifparent = setposcur()-8; 596 } 597 else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 598 { 599 InAgrifParentDef = 29; 600 pos_curagrifparent = setposcur()-20; 601 } 602 else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 603 { 604 InAgrifParentDef = 29; 605 pos_curagrifparent = setposcur()-19; 606 } 607 else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 608 { 609 InAgrifParentDef = 30; 610 pos_curagrifparent = setposcur()-13; 611 } 612 } 317 void NotifyAgrifFunction_0(const char *ident) 318 { 319 if ( firstpass == 1 ) return; 320 321 if ( !strcasecmp(ident,"Agrif_parent") ) 322 { 323 InAgrifParentDef = 1; 324 pos_curagrifparent = setposcur()-12; 325 } 326 else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 327 { 328 InAgrifParentDef = 2; 329 pos_curagrifparent = setposcur()-21; 330 } 331 else if ( !strcasecmp(ident,"Agrif_Rhox") ) 332 { 333 InAgrifParentDef = 3; 334 pos_curagrifparent = setposcur()-10; 335 } 336 else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 337 { 338 InAgrifParentDef = 4; 339 pos_curagrifparent = setposcur()-17; 340 } 341 else if ( !strcasecmp(ident,"Agrif_IRhox") ) 342 { 343 InAgrifParentDef = 5; 344 pos_curagrifparent = setposcur()-11; 345 } 346 else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 347 { 348 InAgrifParentDef = 6; 349 pos_curagrifparent = setposcur()-18; 350 } 351 else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 352 { 353 InAgrifParentDef = 7; 354 pos_curagrifparent = setposcur()-10; 355 } 356 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 357 { 358 InAgrifParentDef = 8; 359 pos_curagrifparent = setposcur()-17; 360 } 361 else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 362 { 363 InAgrifParentDef = 9; 364 pos_curagrifparent = setposcur()-11; 365 } 366 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 367 { 368 InAgrifParentDef = 10; 369 pos_curagrifparent = setposcur()-18; 370 } 371 else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 372 { 373 InAgrifParentDef = 11; 374 pos_curagrifparent = setposcur()-10; 375 } 376 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 377 { 378 InAgrifParentDef = 12; 379 pos_curagrifparent = setposcur()-17; 380 } 381 else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 382 { 383 InAgrifParentDef = 13; 384 pos_curagrifparent = setposcur()-11; 385 } 386 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 387 { 388 InAgrifParentDef = 14; 389 pos_curagrifparent = setposcur()-18; 390 } 391 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 392 { 393 InAgrifParentDef = 15; 394 pos_curagrifparent = setposcur()-23; 395 } 396 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 397 { 398 InAgrifParentDef = 16; 399 pos_curagrifparent = setposcur()-23; 400 } 401 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 402 { 403 InAgrifParentDef = 17; 404 pos_curagrifparent = setposcur()-23; 405 } 406 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 407 { 408 InAgrifParentDef = 18; 409 pos_curagrifparent = setposcur()-26; 410 } 411 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 412 { 413 InAgrifParentDef = 19; 414 pos_curagrifparent = setposcur()-26; 415 } 416 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 417 { 418 InAgrifParentDef = 20; 419 pos_curagrifparent = setposcur()-26; 420 } 421 else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 422 { 423 InAgrifParentDef = 21; 424 pos_curagrifparent = setposcur()-19; 425 } 426 else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 427 { 428 InAgrifParentDef = 22; 429 pos_curagrifparent = setposcur()-17; 430 } 431 else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 432 { 433 InAgrifParentDef = 23; 434 pos_curagrifparent = setposcur()-15; 435 } 436 else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 437 { 438 InAgrifParentDef = 24; 439 pos_curagrifparent = setposcur()-15; 440 } 441 else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 442 { 443 InAgrifParentDef = 25; 444 pos_curagrifparent = setposcur()-15; 445 } 446 else if ( !strcasecmp(ident,"Agrif_Iz") ) 447 { 448 InAgrifParentDef = 26; 449 pos_curagrifparent = setposcur()-8; 450 } 451 else if ( !strcasecmp(ident,"Agrif_Iy") ) 452 { 453 InAgrifParentDef = 27; 454 pos_curagrifparent = setposcur()-8; 455 } 456 else if ( !strcasecmp(ident,"Agrif_Ix") ) 457 { 458 InAgrifParentDef = 28; 459 pos_curagrifparent = setposcur()-8; 460 } 461 else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 462 { 463 InAgrifParentDef = 29; 464 pos_curagrifparent = setposcur()-20; 465 } 466 else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 467 { 468 InAgrifParentDef = 29; 469 pos_curagrifparent = setposcur()-19; 470 } 471 else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 472 { 473 InAgrifParentDef = 30; 474 pos_curagrifparent = setposcur()-13; 475 } 613 476 } 614 477 … … 622 485 /* */ 623 486 /******************************************************************************/ 624 void ModifyTheAgrifFunction_0(c har *ident)487 void ModifyTheAgrifFunction_0(const char *ident) 625 488 { 626 489 if ( InAgrifParentDef != 0 ) 627 490 AgriffunctionModify_0(ident,InAgrifParentDef); 628 /* */629 491 InAgrifParentDef = 0; 630 492 } … … 700 562 /* */ 701 563 /******************************************************************************/ 702 void AgriffunctionModify_0(char *ident,int whichone) 703 { 704 char toprint[LONG_C]; 705 if ( firstpass == 0 ) 706 { 707 strcpy(toprint,""); 708 pos_end = setposcur(); 709 fseek(fortranout,pos_curagrifparent,SEEK_SET); 710 if ( whichone == 1 || whichone == 2 ) 711 { 712 /* */ 713 FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 714 if ( !strcasecmp(ident,toprint) ) 715 { 716 /* la liste des use de cette subroutine */ 717 strcpy(toprint,""); 718 FindAndChangeNameToTabvars(ident, 719 toprint,List_Common_Var,whichone); 720 } 721 if ( !strcasecmp(ident,toprint) ) 722 { 723 /* la liste des use de cette subroutine */ 724 strcpy(toprint,""); 725 FindAndChangeNameToTabvars(ident, 726 toprint,List_ModuleUsed_Var,whichone); 727 } 728 } 729 else if ( whichone == 3 ) /* Agrif_Rhox */ 730 { 731 sprintf(toprint,"REAL("); 732 if( retour77 == 0 ) strcat(toprint," & \n"); 733 else strcat(toprint,"\n & "); 734 strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 735 } 736 else if ( whichone == 4 ) /* Agrif_Parent_Rhox */ 737 { 738 sprintf(toprint,"REAL("); 739 if( retour77 == 0 ) strcat(toprint," & \n"); 740 else strcat(toprint,"\n & "); 741 strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 742 } 743 else if ( whichone == 5 ) /* Agrif_Rhox */ 744 { 745 sprintf(toprint,"Agrif_Curgrid"); 746 if( retour77 == 0 ) strcat(toprint," & \n"); 747 else strcat(toprint,"\n & "); 748 strcat(toprint,"% spaceref(1)"); 749 } 750 else if ( whichone == 6 ) /* Agrif_Parent_Rhox */ 751 { 752 sprintf(toprint,"Agrif_Curgrid"); 753 if( retour77 == 0 ) strcat(toprint," & \n"); 754 else strcat(toprint,"\n & "); 755 strcat(toprint,"% parent % spaceref(1)"); 756 } 757 else if ( whichone == 7 ) /* Agrif_Rhoy */ 758 { 759 sprintf(toprint,"REAL(Agrif_Curgrid"); 760 if( retour77 == 0 ) strcat(toprint," & \n"); 761 else strcat(toprint,"\n & "); 762 strcat(toprint,"% spaceref(2))"); 763 } 764 else if ( whichone == 8 ) /* Agrif_Parent_Rhoy */ 765 { 766 sprintf(toprint,"REAL(Agrif_Curgrid"); 767 if( retour77 == 0 ) strcat(toprint," & \n"); 768 else strcat(toprint,"\n & "); 769 strcat(toprint,"% parent % spaceref(2))"); 770 } 771 else if ( whichone == 9 ) /* Agrif_Rhoy */ 772 { 773 sprintf(toprint,"Agrif_Curgrid"); 774 if( retour77 == 0 ) strcat(toprint," & \n"); 775 else strcat(toprint,"\n & "); 776 strcat(toprint,"% spaceref(2)"); 777 } 778 else if ( whichone == 10 ) /* Agrif_Parent_Rhoy */ 779 { 780 sprintf(toprint,"Agrif_Curgrid"); 781 if( retour77 == 0 ) strcat(toprint," & \n"); 782 else strcat(toprint,"\n & "); 783 strcat(toprint,"% parent % spaceref(2)"); 784 } 785 else if ( whichone == 11 ) /* Agrif_Rhoz */ 786 { 787 sprintf(toprint,"REAL(Agrif_Curgrid"); 788 if( retour77 == 0 ) strcat(toprint," & \n"); 789 else strcat(toprint,"\n & "); 790 strcat(toprint,"% spaceref(3))"); 791 } 792 else if ( whichone == 12 ) /* Agrif_Parent_Rhoz */ 793 { 794 sprintf(toprint,"REAL(Agrif_Curgrid"); 795 if( retour77 == 0 ) strcat(toprint," & \n"); 796 else strcat(toprint,"\n & "); 797 strcat(toprint,"% parent % spaceref(3))"); 798 } 799 else if ( whichone == 13 ) /* Agrif_Rhoz */ 800 { 801 sprintf(toprint,"Agrif_Curgrid"); 802 if( retour77 == 0 ) strcat(toprint," & \n"); 803 else strcat(toprint,"\n & "); 804 strcat(toprint,"% spaceref(3)"); 805 } 806 else if ( whichone == 14 ) /* Agrif_Parent_Rhoz */ 807 { 808 sprintf(toprint,"Agrif_Curgrid"); 809 if( retour77 == 0 ) strcat(toprint," & \n"); 810 else strcat(toprint,"\n & "); 811 strcat(toprint,"% parent % spaceref(3)"); 812 } 813 else if ( whichone == 15 ) /* Agrif_NearCommonBorderX */ 814 { 815 sprintf(toprint,"Agrif_Curgrid"); 816 if( retour77 == 0 ) strcat(toprint," & \n"); 817 else strcat(toprint,"\n & "); 818 strcat(toprint,"% NearRootBorder(1)"); 819 } 820 else if ( whichone == 16 ) /* Agrif_NearCommonBorderY */ 821 { 822 sprintf(toprint,"Agrif_Curgrid"); 823 if( retour77 == 0 ) strcat(toprint," & \n"); 824 else strcat(toprint,"\n & "); 825 strcat(toprint,"% NearRootBorder(2)"); 826 } 827 else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ */ 828 { 829 sprintf(toprint,"Agrif_Curgrid"); 830 if( retour77 == 0 ) strcat(toprint," & \n"); 831 else strcat(toprint,"\n & "); 832 strcat(toprint,"% NearRootBorder(3)"); 833 } 834 else if ( whichone == 18 ) /* Agrif_NearCommonBorderX */ 835 { 836 sprintf(toprint,"Agrif_Curgrid"); 837 if( retour77 == 0 ) strcat(toprint," & \n"); 838 else strcat(toprint,"\n & "); 564 void AgriffunctionModify_0(const char *ident,int whichone) 565 { 566 char toprint[LONG_M]; 567 if ( firstpass == 0 ) 568 { 569 strcpy(toprint,""); 570 pos_end = setposcur(); 571 fseek(fortran_out,pos_curagrifparent,SEEK_SET); 572 if ( whichone == 1 || whichone == 2 ) 573 { 574 FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 575 if ( !strcasecmp(ident,toprint) ) 576 { 577 /* la liste des use de cette subroutine */ 578 strcpy(toprint,""); 579 FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone); 580 } 581 if ( !strcasecmp(ident,toprint) ) 582 { 583 /* la liste des use de cette subroutine */ 584 strcpy(toprint,""); 585 FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone); 586 } 587 } 588 else if ( whichone == 3 ) /* Agrif_Rhox */ 589 { 590 sprintf(toprint,"REAL("); 591 if( retour77 == 0 ) strcat(toprint," & \n"); 592 else strcat(toprint,"\n & "); 593 strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 594 } 595 else if ( whichone == 4 ) /* Agrif_Parent_Rhox */ 596 { 597 sprintf(toprint,"REAL("); 598 if( retour77 == 0 ) strcat(toprint," & \n"); 599 else strcat(toprint,"\n & "); 600 strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 601 } 602 else if ( whichone == 5 ) /* Agrif_Rhox */ 603 { 604 sprintf(toprint,"Agrif_Curgrid"); 605 if( retour77 == 0 ) strcat(toprint," & \n"); 606 else strcat(toprint,"\n & "); 607 strcat(toprint,"% spaceref(1)"); 608 } 609 else if ( whichone == 6 ) /* Agrif_Parent_Rhox */ 610 { 611 sprintf(toprint,"Agrif_Curgrid"); 612 if( retour77 == 0 ) strcat(toprint," & \n"); 613 else strcat(toprint,"\n & "); 614 strcat(toprint,"% parent % spaceref(1)"); 615 } 616 else if ( whichone == 7 ) /* Agrif_Rhoy */ 617 { 618 sprintf(toprint,"REAL(Agrif_Curgrid"); 619 if( retour77 == 0 ) strcat(toprint," & \n"); 620 else strcat(toprint,"\n & "); 621 strcat(toprint,"% spaceref(2))"); 622 } 623 else if ( whichone == 8 ) /* Agrif_Parent_Rhoy */ 624 { 625 sprintf(toprint,"REAL(Agrif_Curgrid"); 626 if( retour77 == 0 ) strcat(toprint," & \n"); 627 else strcat(toprint,"\n & "); 628 strcat(toprint,"% parent % spaceref(2))"); 629 } 630 else if ( whichone == 9 ) /* Agrif_Rhoy */ 631 { 632 sprintf(toprint,"Agrif_Curgrid"); 633 if( retour77 == 0 ) strcat(toprint," & \n"); 634 else strcat(toprint,"\n & "); 635 strcat(toprint,"% spaceref(2)"); 636 } 637 else if ( whichone == 10 ) /* Agrif_Parent_Rhoy */ 638 { 639 sprintf(toprint,"Agrif_Curgrid"); 640 if( retour77 == 0 ) strcat(toprint," & \n"); 641 else strcat(toprint,"\n & "); 642 strcat(toprint,"% parent % spaceref(2)"); 643 } 644 else if ( whichone == 11 ) /* Agrif_Rhoz */ 645 { 646 sprintf(toprint,"REAL(Agrif_Curgrid"); 647 if( retour77 == 0 ) strcat(toprint," & \n"); 648 else strcat(toprint,"\n & "); 649 strcat(toprint,"% spaceref(3))"); 650 } 651 else if ( whichone == 12 ) /* Agrif_Parent_Rhoz */ 652 { 653 sprintf(toprint,"REAL(Agrif_Curgrid"); 654 if( retour77 == 0 ) strcat(toprint," & \n"); 655 else strcat(toprint,"\n & "); 656 strcat(toprint,"% parent % spaceref(3))"); 657 } 658 else if ( whichone == 13 ) /* Agrif_Rhoz */ 659 { 660 sprintf(toprint,"Agrif_Curgrid"); 661 if( retour77 == 0 ) strcat(toprint," & \n"); 662 else strcat(toprint,"\n & "); 663 strcat(toprint,"% spaceref(3)"); 664 } 665 else if ( whichone == 14 ) /* Agrif_Parent_Rhoz */ 666 { 667 sprintf(toprint,"Agrif_Curgrid"); 668 if( retour77 == 0 ) strcat(toprint," & \n"); 669 else strcat(toprint,"\n & "); 670 strcat(toprint,"% parent % spaceref(3)"); 671 } 672 else if ( whichone == 15 ) /* Agrif_NearCommonBorderX */ 673 { 674 sprintf(toprint,"Agrif_Curgrid"); 675 if( retour77 == 0 ) strcat(toprint," & \n"); 676 else strcat(toprint,"\n & "); 677 strcat(toprint,"% NearRootBorder(1)"); 678 } 679 else if ( whichone == 16 ) /* Agrif_NearCommonBorderY */ 680 { 681 sprintf(toprint,"Agrif_Curgrid"); 682 if( retour77 == 0 ) strcat(toprint," & \n"); 683 else strcat(toprint,"\n & "); 684 strcat(toprint,"% NearRootBorder(2)"); 685 } 686 else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ */ 687 { 688 sprintf(toprint,"Agrif_Curgrid"); 689 if( retour77 == 0 ) strcat(toprint," & \n"); 690 else strcat(toprint,"\n & "); 691 strcat(toprint,"% NearRootBorder(3)"); 692 } 693 else if ( whichone == 18 ) /* Agrif_NearCommonBorderX */ 694 { 695 sprintf(toprint,"Agrif_Curgrid"); 696 if( retour77 == 0 ) strcat(toprint," & \n"); 697 else strcat(toprint,"\n & "); 839 698 strcat(toprint,"% DistantRootBorder(1)"); 840 } 841 else if ( whichone == 19 ) /* Agrif_NearCommonBorderY */ 842 { 843 sprintf(toprint,"Agrif_Curgrid"); 844 if( retour77 == 0 ) strcat(toprint," & \n"); 845 else strcat(toprint,"\n & "); 846 strcat(toprint,"% DistantRootBorder(2)"); 847 } 848 else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ */ 849 { 850 sprintf(toprint,"Agrif_Curgrid"); 851 if( retour77 == 0 ) strcat(toprint," & \n"); 852 else strcat(toprint,"\n & "); 853 strcat(toprint,"% DistantRootBorder(3)"); 854 } 855 else if ( whichone == 21 ) /* Agrif_Get_parent_id */ 856 { 857 sprintf(toprint,"Agrif_Curgrid"); 858 if( retour77 == 0 ) strcat(toprint," & \n"); 859 else strcat(toprint,"\n & "); 860 strcat(toprint,"% parent % grid_id"); 861 } 862 else if ( whichone == 22 ) /* Agrif_Get_grid_id */ 863 { 864 sprintf(toprint,"Agrif_Curgrid"); 865 if( retour77 == 0 ) strcat(toprint," & \n"); 866 else strcat(toprint,"\n & "); 867 strcat(toprint,"% grid_id"); 868 } 869 else if ( whichone == 23 ) /* Agrif_Parent_Iz */ 870 { 871 sprintf(toprint,"Agrif_Curgrid"); 872 if( retour77 == 0 ) strcat(toprint," & \n"); 873 else strcat(toprint,"\n & "); 874 strcat(toprint,"% parent % ix(3)"); 875 } 876 else if ( whichone == 24 ) /* Agrif_Parent_Iy */ 877 { 878 sprintf(toprint,"Agrif_Curgrid"); 879 if( retour77 == 0 ) strcat(toprint," & \n"); 880 else strcat(toprint,"\n & "); 881 strcat(toprint,"% parent % ix(2)"); 882 } 883 else if ( whichone == 25 ) /* Agrif_Parent_Ix */ 884 { 885 sprintf(toprint,"Agrif_Curgrid"); 886 if( retour77 == 0 ) strcat(toprint," & \n"); 887 else strcat(toprint,"\n & "); 888 strcat(toprint,"% parent % ix(1)"); 889 } 890 else if ( whichone == 26 ) /* Agrif_Iz */ 891 { 892 sprintf(toprint,"Agrif_Curgrid"); 893 if( retour77 == 0 ) strcat(toprint," & \n"); 894 else strcat(toprint,"\n & "); 895 strcat(toprint," % ix(3)"); 896 } 897 else if ( whichone == 27 ) /* Agrif_Iy */ 898 { 899 sprintf(toprint,"Agrif_Curgrid"); 900 if( retour77 == 0 ) strcat(toprint," & \n"); 901 else strcat(toprint,"\n & "); 902 strcat(toprint,"% ix(2)"); 903 } 904 else if ( whichone == 28 ) /* Agrif_Ix */ 905 { 906 sprintf(toprint,"Agrif_Curgrid"); 907 if( retour77 == 0 ) strcat(toprint," & \n"); 908 else strcat(toprint,"\n & "); 909 strcat(toprint,"% ix(1)"); 910 } 911 else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids */ 912 { 913 sprintf(toprint,"Agrif_nbfixedgrids"); 914 } 915 else if ( whichone == 30 ) /* AGRIF_Nb_Step */ 916 { 917 sprintf(toprint,"Agrif_Curgrid"); 918 if( retour77 == 0 ) strcat(toprint," & \n"); 919 else strcat(toprint,"\n & "); 920 strcat(toprint,"% ngridstep"); 921 } 922 /* */ 923 if ( whichone == 1 || whichone == 2 ) 924 { 925 Save_Length(toprint,43); 926 tofich(fortranout,toprint,2); 927 } 928 else 929 { 930 /* if( retour77 == 0 ) fprintf(fortranout," & \n"); 931 else fprintf(fortranout,"\n & ");*/ 932 Save_Length(toprint,43); 933 fprintf(fortranout,"%s",toprint); 934 } 935 } 936 } 937 699 } 700 else if ( whichone == 19 ) /* Agrif_NearCommonBorderY */ 701 { 702 sprintf(toprint,"Agrif_Curgrid"); 703 if( retour77 == 0 ) strcat(toprint," & \n"); 704 else strcat(toprint,"\n & "); 705 strcat(toprint,"% DistantRootBorder(2)"); 706 } 707 else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ */ 708 { 709 sprintf(toprint,"Agrif_Curgrid"); 710 if( retour77 == 0 ) strcat(toprint," & \n"); 711 else strcat(toprint,"\n & "); 712 strcat(toprint,"% DistantRootBorder(3)"); 713 } 714 else if ( whichone == 21 ) /* Agrif_Get_parent_id */ 715 { 716 sprintf(toprint,"Agrif_Curgrid"); 717 if( retour77 == 0 ) strcat(toprint," & \n"); 718 else strcat(toprint,"\n & "); 719 strcat(toprint,"% parent % grid_id"); 720 } 721 else if ( whichone == 22 ) /* Agrif_Get_grid_id */ 722 { 723 sprintf(toprint,"Agrif_Curgrid"); 724 if( retour77 == 0 ) strcat(toprint," & \n"); 725 else strcat(toprint,"\n & "); 726 strcat(toprint,"% grid_id"); 727 } 728 else if ( whichone == 23 ) /* Agrif_Parent_Iz */ 729 { 730 sprintf(toprint,"Agrif_Curgrid"); 731 if( retour77 == 0 ) strcat(toprint," & \n"); 732 else strcat(toprint,"\n & "); 733 strcat(toprint,"% parent % ix(3)"); 734 } 735 else if ( whichone == 24 ) /* Agrif_Parent_Iy */ 736 { 737 sprintf(toprint,"Agrif_Curgrid"); 738 if( retour77 == 0 ) strcat(toprint," & \n"); 739 else strcat(toprint,"\n & "); 740 strcat(toprint,"% parent % ix(2)"); 741 } 742 else if ( whichone == 25 ) /* Agrif_Parent_Ix */ 743 { 744 sprintf(toprint,"Agrif_Curgrid"); 745 if( retour77 == 0 ) strcat(toprint," & \n"); 746 else strcat(toprint,"\n & "); 747 strcat(toprint,"% parent % ix(1)"); 748 } 749 else if ( whichone == 26 ) /* Agrif_Iz */ 750 { 751 sprintf(toprint,"Agrif_Curgrid"); 752 if( retour77 == 0 ) strcat(toprint," & \n"); 753 else strcat(toprint,"\n & "); 754 strcat(toprint," % ix(3)"); 755 } 756 else if ( whichone == 27 ) /* Agrif_Iy */ 757 { 758 sprintf(toprint,"Agrif_Curgrid"); 759 if( retour77 == 0 ) strcat(toprint," & \n"); 760 else strcat(toprint,"\n & "); 761 strcat(toprint,"% ix(2)"); 762 } 763 else if ( whichone == 28 ) /* Agrif_Ix */ 764 { 765 sprintf(toprint,"Agrif_Curgrid"); 766 if( retour77 == 0 ) strcat(toprint," & \n"); 767 else strcat(toprint,"\n & "); 768 strcat(toprint,"% ix(1)"); 769 } 770 else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids */ 771 { 772 sprintf(toprint,"Agrif_nbfixedgrids"); 773 } 774 else if ( whichone == 30 ) /* AGRIF_Nb_Step */ 775 { 776 sprintf(toprint,"Agrif_Curgrid"); 777 if( retour77 == 0 ) strcat(toprint," & \n"); 778 else strcat(toprint,"\n & "); 779 strcat(toprint,"% ngridstep"); 780 } 781 782 Save_Length(toprint,43); 783 784 if ( whichone == 1 || whichone == 2 ) tofich(fortran_out,toprint,0); 785 else fprintf(fortran_out,"%s",toprint); 786 } 787 } 938 788 939 789 /******************************************************************************/ … … 946 796 /* */ 947 797 /******************************************************************************/ 948 void Instanciation_0(char *ident) 949 { 950 listvar *newvar; 951 int out; 952 953 if ( firstpass == 0 && sameagrifargument == 1 ) 954 { 955 newvar = List_Global_Var; 956 957 out=0; 958 while ( newvar && out == 0 ) 959 { 960 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 961 else newvar=newvar->suiv; 962 } 963 964 if ( out == 0 ) 965 { 966 newvar = List_Common_Var; 967 968 out=0; 969 while ( newvar && out == 0 ) 970 { 798 void Instanciation_0(const char *ident) 799 { 800 listvar *newvar; 801 int out; 802 803 if ( firstpass == 0 && sameagrifargument == 1 ) 804 { 805 newvar = List_Global_Var; 806 out = 0; 807 while ( newvar && out == 0 ) 808 { 971 809 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 972 else newvar=newvar->suiv; 973 } 974 } 975 if ( out == 0 ) 976 { 977 newvar = List_ModuleUsed_Var; 978 979 out=0; 980 while ( newvar && out == 0 ) 981 { 982 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 983 else newvar=newvar->suiv; 984 } 985 } 986 987 if ( out == 1 ) 988 { 989 /* then write the instanciation */ 990 fprintf(fortranout,"\n %s = %s",ident, 991 vargridcurgridtabvars(newvar->var,3)); 992 colnum = 0; 993 } 994 } 995 sameagrifargument = 0; 996 } 810 else newvar = newvar->suiv; 811 } 812 if ( out == 0 ) 813 { 814 newvar = List_Common_Var; 815 while ( newvar && out == 0 ) 816 { 817 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 818 else newvar = newvar->suiv; 819 } 820 } 821 if ( out == 0 ) 822 { 823 newvar = List_ModuleUsed_Var; 824 while ( newvar && out == 0 ) 825 { 826 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 827 else newvar = newvar->suiv; 828 } 829 } 830 // if ( out == 1 ) 831 // { 832 // /* then write the instanciation */ 833 // fprintf(fortran_out,"\n %s = %s",ident,vargridcurgridtabvars(newvar->var,3)); 834 // printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3)); 835 // } 836 } 837 sameagrifargument = 0; 838 }
Note: See TracChangeset
for help on using the changeset viewer.