Changeset 6617 for branches/UKMO/dev_r5518_v3.4_asm_nemovar_community/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
- Timestamp:
- 2016-05-25T13:16:58+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_v3.4_asm_nemovar_community/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
r6613 r6617 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 { 277 if( strcasecmp(subroutinename,"Agrif_InvLoc") ) 278 fprintf(fileout,"\n USE Agrif_Util \n"); 279 else fprintf(fileout,"\n USE Agrif_Types \n"); 280 281 } 416 282 } 417 283 } … … 419 285 void AddUseAgrifUtilBeforeCall_0(FILE *fileout) 420 286 { 421 listusemodule *parcours;422 423 int out;287 listusemodule *parcours; 288 289 int out; 424 290 425 291 if ( firstpass == 0 ) … … 437 303 if ( out == 0 ) 438 304 { 439 fprintf(fileout,"\n USE Agrif_Util \n"); 305 if( strcasecmp(subroutinename,"Agrif_InitWorkspace") ) 306 fprintf(fileout,"\n USE Agrif_Util \n"); 307 else fprintf(fileout,"\n USE Agrif_Types \n"); 440 308 } 441 309 } … … 451 319 /* */ 452 320 /******************************************************************************/ 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 } 321 void NotifyAgrifFunction_0(const char *ident) 322 { 323 if ( firstpass == 1 ) return; 324 325 if ( !strcasecmp(ident,"Agrif_parent") ) 326 { 327 InAgrifParentDef = 1; 328 pos_curagrifparent = setposcur()-12; 329 } 330 else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) 331 { 332 InAgrifParentDef = 2; 333 pos_curagrifparent = setposcur()-21; 334 } 335 else if ( !strcasecmp(ident,"Agrif_Rhox") ) 336 { 337 InAgrifParentDef = 3; 338 pos_curagrifparent = setposcur()-10; 339 } 340 else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) 341 { 342 InAgrifParentDef = 4; 343 pos_curagrifparent = setposcur()-17; 344 } 345 else if ( !strcasecmp(ident,"Agrif_IRhox") ) 346 { 347 InAgrifParentDef = 5; 348 pos_curagrifparent = setposcur()-11; 349 } 350 else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) 351 { 352 InAgrifParentDef = 6; 353 pos_curagrifparent = setposcur()-18; 354 } 355 else if ( !strcasecmp(ident,"Agrif_Rhoy") ) 356 { 357 InAgrifParentDef = 7; 358 pos_curagrifparent = setposcur()-10; 359 } 360 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) 361 { 362 InAgrifParentDef = 8; 363 pos_curagrifparent = setposcur()-17; 364 } 365 else if ( !strcasecmp(ident,"Agrif_IRhoy") ) 366 { 367 InAgrifParentDef = 9; 368 pos_curagrifparent = setposcur()-11; 369 } 370 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) 371 { 372 InAgrifParentDef = 10; 373 pos_curagrifparent = setposcur()-18; 374 } 375 else if ( !strcasecmp(ident,"Agrif_Rhoz") ) 376 { 377 InAgrifParentDef = 11; 378 pos_curagrifparent = setposcur()-10; 379 } 380 else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) 381 { 382 InAgrifParentDef = 12; 383 pos_curagrifparent = setposcur()-17; 384 } 385 else if ( !strcasecmp(ident,"Agrif_IRhoz") ) 386 { 387 InAgrifParentDef = 13; 388 pos_curagrifparent = setposcur()-11; 389 } 390 else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) 391 { 392 InAgrifParentDef = 14; 393 pos_curagrifparent = setposcur()-18; 394 } 395 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) 396 { 397 InAgrifParentDef = 15; 398 pos_curagrifparent = setposcur()-23; 399 } 400 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) 401 { 402 InAgrifParentDef = 16; 403 pos_curagrifparent = setposcur()-23; 404 } 405 else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) 406 { 407 InAgrifParentDef = 17; 408 pos_curagrifparent = setposcur()-23; 409 } 410 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) 411 { 412 InAgrifParentDef = 18; 413 pos_curagrifparent = setposcur()-26; 414 } 415 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) 416 { 417 InAgrifParentDef = 19; 418 pos_curagrifparent = setposcur()-26; 419 } 420 else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) 421 { 422 InAgrifParentDef = 20; 423 pos_curagrifparent = setposcur()-26; 424 } 425 else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) 426 { 427 InAgrifParentDef = 21; 428 pos_curagrifparent = setposcur()-19; 429 } 430 else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) 431 { 432 InAgrifParentDef = 22; 433 pos_curagrifparent = setposcur()-17; 434 } 435 else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) 436 { 437 InAgrifParentDef = 23; 438 pos_curagrifparent = setposcur()-15; 439 } 440 else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) 441 { 442 InAgrifParentDef = 24; 443 pos_curagrifparent = setposcur()-15; 444 } 445 else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) 446 { 447 InAgrifParentDef = 25; 448 pos_curagrifparent = setposcur()-15; 449 } 450 else if ( !strcasecmp(ident,"Agrif_Iz") ) 451 { 452 InAgrifParentDef = 26; 453 pos_curagrifparent = setposcur()-8; 454 } 455 else if ( !strcasecmp(ident,"Agrif_Iy") ) 456 { 457 InAgrifParentDef = 27; 458 pos_curagrifparent = setposcur()-8; 459 } 460 else if ( !strcasecmp(ident,"Agrif_Ix") ) 461 { 462 InAgrifParentDef = 28; 463 pos_curagrifparent = setposcur()-8; 464 } 465 else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) 466 { 467 InAgrifParentDef = 29; 468 pos_curagrifparent = setposcur()-20; 469 } 470 else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) 471 { 472 InAgrifParentDef = 29; 473 pos_curagrifparent = setposcur()-19; 474 } 475 else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) 476 { 477 InAgrifParentDef = 30; 478 pos_curagrifparent = setposcur()-13; 479 } 613 480 } 614 481 … … 622 489 /* */ 623 490 /******************************************************************************/ 624 void ModifyTheAgrifFunction_0(c har *ident)491 void ModifyTheAgrifFunction_0(const char *ident) 625 492 { 626 493 if ( InAgrifParentDef != 0 ) 627 494 AgriffunctionModify_0(ident,InAgrifParentDef); 628 /* */629 495 InAgrifParentDef = 0; 630 496 } … … 700 566 /* */ 701 567 /******************************************************************************/ 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 & "); 568 void AgriffunctionModify_0(const char *ident,int whichone) 569 { 570 char toprint[LONG_M]; 571 if ( firstpass == 0 ) 572 { 573 strcpy(toprint,""); 574 pos_end = setposcur(); 575 fseek(fortran_out,pos_curagrifparent,SEEK_SET); 576 if ( whichone == 1 || whichone == 2 ) 577 { 578 FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); 579 if ( !strcasecmp(ident,toprint) ) 580 { 581 /* la liste des use de cette subroutine */ 582 strcpy(toprint,""); 583 FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone); 584 } 585 if ( !strcasecmp(ident,toprint) ) 586 { 587 /* la liste des use de cette subroutine */ 588 strcpy(toprint,""); 589 FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone); 590 } 591 } 592 else if ( whichone == 3 ) /* Agrif_Rhox */ 593 { 594 sprintf(toprint,"REAL("); 595 if( retour77 == 0 ) strcat(toprint," & \n"); 596 else strcat(toprint,"\n & "); 597 strcat(toprint,"Agrif_Curgrid % spaceref(1))"); 598 } 599 else if ( whichone == 4 ) /* Agrif_Parent_Rhox */ 600 { 601 sprintf(toprint,"REAL("); 602 if( retour77 == 0 ) strcat(toprint," & \n"); 603 else strcat(toprint,"\n & "); 604 strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); 605 } 606 else if ( whichone == 5 ) /* Agrif_Rhox */ 607 { 608 sprintf(toprint,"Agrif_Curgrid"); 609 if( retour77 == 0 ) strcat(toprint," & \n"); 610 else strcat(toprint,"\n & "); 611 strcat(toprint,"% spaceref(1)"); 612 } 613 else if ( whichone == 6 ) /* Agrif_Parent_Rhox */ 614 { 615 sprintf(toprint,"Agrif_Curgrid"); 616 if( retour77 == 0 ) strcat(toprint," & \n"); 617 else strcat(toprint,"\n & "); 618 strcat(toprint,"% parent % spaceref(1)"); 619 } 620 else if ( whichone == 7 ) /* Agrif_Rhoy */ 621 { 622 sprintf(toprint,"REAL(Agrif_Curgrid"); 623 if( retour77 == 0 ) strcat(toprint," & \n"); 624 else strcat(toprint,"\n & "); 625 strcat(toprint,"% spaceref(2))"); 626 } 627 else if ( whichone == 8 ) /* Agrif_Parent_Rhoy */ 628 { 629 sprintf(toprint,"REAL(Agrif_Curgrid"); 630 if( retour77 == 0 ) strcat(toprint," & \n"); 631 else strcat(toprint,"\n & "); 632 strcat(toprint,"% parent % spaceref(2))"); 633 } 634 else if ( whichone == 9 ) /* Agrif_Rhoy */ 635 { 636 sprintf(toprint,"Agrif_Curgrid"); 637 if( retour77 == 0 ) strcat(toprint," & \n"); 638 else strcat(toprint,"\n & "); 639 strcat(toprint,"% spaceref(2)"); 640 } 641 else if ( whichone == 10 ) /* Agrif_Parent_Rhoy */ 642 { 643 sprintf(toprint,"Agrif_Curgrid"); 644 if( retour77 == 0 ) strcat(toprint," & \n"); 645 else strcat(toprint,"\n & "); 646 strcat(toprint,"% parent % spaceref(2)"); 647 } 648 else if ( whichone == 11 ) /* Agrif_Rhoz */ 649 { 650 sprintf(toprint,"REAL(Agrif_Curgrid"); 651 if( retour77 == 0 ) strcat(toprint," & \n"); 652 else strcat(toprint,"\n & "); 653 strcat(toprint,"% spaceref(3))"); 654 } 655 else if ( whichone == 12 ) /* Agrif_Parent_Rhoz */ 656 { 657 sprintf(toprint,"REAL(Agrif_Curgrid"); 658 if( retour77 == 0 ) strcat(toprint," & \n"); 659 else strcat(toprint,"\n & "); 660 strcat(toprint,"% parent % spaceref(3))"); 661 } 662 else if ( whichone == 13 ) /* Agrif_Rhoz */ 663 { 664 sprintf(toprint,"Agrif_Curgrid"); 665 if( retour77 == 0 ) strcat(toprint," & \n"); 666 else strcat(toprint,"\n & "); 667 strcat(toprint,"% spaceref(3)"); 668 } 669 else if ( whichone == 14 ) /* Agrif_Parent_Rhoz */ 670 { 671 sprintf(toprint,"Agrif_Curgrid"); 672 if( retour77 == 0 ) strcat(toprint," & \n"); 673 else strcat(toprint,"\n & "); 674 strcat(toprint,"% parent % spaceref(3)"); 675 } 676 else if ( whichone == 15 ) /* Agrif_NearCommonBorderX */ 677 { 678 sprintf(toprint,"Agrif_Curgrid"); 679 if( retour77 == 0 ) strcat(toprint," & \n"); 680 else strcat(toprint,"\n & "); 681 strcat(toprint,"% NearRootBorder(1)"); 682 } 683 else if ( whichone == 16 ) /* Agrif_NearCommonBorderY */ 684 { 685 sprintf(toprint,"Agrif_Curgrid"); 686 if( retour77 == 0 ) strcat(toprint," & \n"); 687 else strcat(toprint,"\n & "); 688 strcat(toprint,"% NearRootBorder(2)"); 689 } 690 else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ */ 691 { 692 sprintf(toprint,"Agrif_Curgrid"); 693 if( retour77 == 0 ) strcat(toprint," & \n"); 694 else strcat(toprint,"\n & "); 695 strcat(toprint,"% NearRootBorder(3)"); 696 } 697 else if ( whichone == 18 ) /* Agrif_NearCommonBorderX */ 698 { 699 sprintf(toprint,"Agrif_Curgrid"); 700 if( retour77 == 0 ) strcat(toprint," & \n"); 701 else strcat(toprint,"\n & "); 839 702 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 703 } 704 else if ( whichone == 19 ) /* Agrif_NearCommonBorderY */ 705 { 706 sprintf(toprint,"Agrif_Curgrid"); 707 if( retour77 == 0 ) strcat(toprint," & \n"); 708 else strcat(toprint,"\n & "); 709 strcat(toprint,"% DistantRootBorder(2)"); 710 } 711 else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ */ 712 { 713 sprintf(toprint,"Agrif_Curgrid"); 714 if( retour77 == 0 ) strcat(toprint," & \n"); 715 else strcat(toprint,"\n & "); 716 strcat(toprint,"% DistantRootBorder(3)"); 717 } 718 else if ( whichone == 21 ) /* Agrif_Get_parent_id */ 719 { 720 sprintf(toprint,"Agrif_Curgrid"); 721 if( retour77 == 0 ) strcat(toprint," & \n"); 722 else strcat(toprint,"\n & "); 723 strcat(toprint,"% parent % grid_id"); 724 } 725 else if ( whichone == 22 ) /* Agrif_Get_grid_id */ 726 { 727 sprintf(toprint,"Agrif_Curgrid"); 728 if( retour77 == 0 ) strcat(toprint," & \n"); 729 else strcat(toprint,"\n & "); 730 strcat(toprint,"% grid_id"); 731 } 732 else if ( whichone == 23 ) /* Agrif_Parent_Iz */ 733 { 734 sprintf(toprint,"Agrif_Curgrid"); 735 if( retour77 == 0 ) strcat(toprint," & \n"); 736 else strcat(toprint,"\n & "); 737 strcat(toprint,"% parent % ix(3)"); 738 } 739 else if ( whichone == 24 ) /* Agrif_Parent_Iy */ 740 { 741 sprintf(toprint,"Agrif_Curgrid"); 742 if( retour77 == 0 ) strcat(toprint," & \n"); 743 else strcat(toprint,"\n & "); 744 strcat(toprint,"% parent % ix(2)"); 745 } 746 else if ( whichone == 25 ) /* Agrif_Parent_Ix */ 747 { 748 sprintf(toprint,"Agrif_Curgrid"); 749 if( retour77 == 0 ) strcat(toprint," & \n"); 750 else strcat(toprint,"\n & "); 751 strcat(toprint,"% parent % ix(1)"); 752 } 753 else if ( whichone == 26 ) /* Agrif_Iz */ 754 { 755 sprintf(toprint,"Agrif_Curgrid"); 756 if( retour77 == 0 ) strcat(toprint," & \n"); 757 else strcat(toprint,"\n & "); 758 strcat(toprint," % ix(3)"); 759 } 760 else if ( whichone == 27 ) /* Agrif_Iy */ 761 { 762 sprintf(toprint,"Agrif_Curgrid"); 763 if( retour77 == 0 ) strcat(toprint," & \n"); 764 else strcat(toprint,"\n & "); 765 strcat(toprint,"% ix(2)"); 766 } 767 else if ( whichone == 28 ) /* Agrif_Ix */ 768 { 769 sprintf(toprint,"Agrif_Curgrid"); 770 if( retour77 == 0 ) strcat(toprint," & \n"); 771 else strcat(toprint,"\n & "); 772 strcat(toprint,"% ix(1)"); 773 } 774 else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids */ 775 { 776 sprintf(toprint,"Agrif_nbfixedgrids"); 777 } 778 else if ( whichone == 30 ) /* AGRIF_Nb_Step */ 779 { 780 sprintf(toprint,"Agrif_Curgrid"); 781 if( retour77 == 0 ) strcat(toprint," & \n"); 782 else strcat(toprint,"\n & "); 783 strcat(toprint,"% ngridstep"); 784 } 785 786 Save_Length(toprint,43); 787 788 if ( whichone == 1 || whichone == 2 ) tofich(fortran_out,toprint,0); 789 else fprintf(fortran_out,"%s",toprint); 790 } 791 } 938 792 939 793 /******************************************************************************/ … … 946 800 /* */ 947 801 /******************************************************************************/ 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 { 802 void Instanciation_0(const char *ident) 803 { 804 listvar *newvar; 805 int out; 806 807 if ( firstpass == 0 && sameagrifargument == 1 ) 808 { 809 newvar = List_Global_Var; 810 out = 0; 811 while ( newvar && out == 0 ) 812 { 971 813 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 } 814 else newvar = newvar->suiv; 815 } 816 if ( out == 0 ) 817 { 818 newvar = List_Common_Var; 819 while ( newvar && out == 0 ) 820 { 821 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 822 else newvar = newvar->suiv; 823 } 824 } 825 if ( out == 0 ) 826 { 827 newvar = List_ModuleUsed_Var; 828 while ( newvar && out == 0 ) 829 { 830 if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 831 else newvar = newvar->suiv; 832 } 833 } 834 // if ( out == 1 ) 835 // { 836 // /* then write the instanciation */ 837 // fprintf(fortran_out,"\n %s = %s",ident,vargridcurgridtabvars(newvar->var,3)); 838 // printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3)); 839 // } 840 } 841 sameagrifargument = 0; 842 }
Note: See TracChangeset
for help on using the changeset viewer.