1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810
| #!/usr/bin/perl
#!/usr/local/bin/perl
use strict;
use warnings;
use English;
use File::Basename;
use Text::Wrap;
## HISTORY
## 01 - Etapes mises en fonctions (pour profiling)
## 02 - OPTIM 1: compiler les regexp.
## 03 - OPTIM 2: lecture fichier fgmsh_dpl dans une fonction
## 04 - OPTIM 3: lecture fichier fgmsh_dpl pour "n" noeuds au lieu d'un seul (un seul lu à la fois)
## 05 - OPTIM 4: lecture fichier fgmsh_dpl pour "n" noeuds au lieu d'un seul (tous lus en une fois)
## 06 - OPTIM 5: split au lieu de regexp pour l'extraction des infos d'une ligne de noeud dans les donnes de noeud
## option verbose pour ne pas afficher les "verification deplacements ..."
## 07 - OPTIM 6: suppression des paramètres inutiles entre etape 4 et 5
## read_dpl : eviter de stocker le temps dans les données de noeud (déjà stocké dans un tableau)
$Text::Wrap::columns = 81;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1)
my $NOM_PROG = basename $PROGRAM_NAME;
#pattern d un reel pour les regex (pourrait etre remplacee par $RE{num}{real} du package Regexp::Common)
my $format_reel = qr/[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?/;
#my $format_fgmsh = qr/^\s*(\d+)\s+($format_reel)\s+($format_reel)\s+($format_reel)\s*$/;
#my $node_data = qr/^\s*\$NodeData\s*$/;
#my $end_node_data = qr/^\s*\$EndNodeData\s*$/;
my $verbose = 0;
#########################################################################################################################
#
# resume des etapes :
# ETAPE 0 => recuperation des arguments, affichage eventuel de l aide, etc... (rien a signaler => etape rapide)
# ETAPE 1 => lecture des 2 maillages (rien a signaler => etape rapide)
# ETAPE 2 => determination des noeuds communs aux 2 maillages (rien a signaler => etape rapide)
# ETAPE 3 => verification du fichier fdpl_1 contenant les deplacements (etape un peu longue mais sans plus)
# ETAPE 4 => ecriture de plein fichiers temporaires que l on concatene ensuite un seul fichier (ETAPE TRES LONGUE!!!!!!!!!)
# ETAPE 5 => ecriture de quelques fichiers supplementaires (rien a signaler => etape rapide)
#
#########################################################################################################################
sub etape0();sub etape1(%); sub etape2(%); sub etape3(%); sub etape4(%); sub etape5(%);
my %opt = etape0();
%opt = (%opt, etape1(%opt));
%opt = (%opt, etape2(%opt));
%opt = (%opt, etape3(%opt));
%opt = (%opt, etape4(%opt));
etape5(%opt);
#
#
#
# le script s arrete la. Le reste, c est la definition des subroutines
#
#
#
sub etape0() {
#########################################################################################################################
#
# ETAPE 0
#
# recuperation des arguments, affichage eventuel de l aide, etc...
#
# rien a dire sauf qu un jour, il faudra vraiment que je regarde le package getopt
# bref...
#
#########################################################################################################################
#premier balyage des arguments pour reperer une demande d affichage de l aide
# => si option du style -h ou -help => affichage aide
my $isOpt_help = 0;
foreach my $arg (@ARGV) {
if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
$isOpt_help = 1;
}
}
#si option -h|-help ou pas d arguments => affichage aide
if($isOpt_help or ($#ARGV < 3)) {
my $indent = " "; $indent .= " " for(1 .. length($NOM_PROG));
print "\n";
print "--------------------------------------------------------------------------------\n";
print wrap("",$indent,
" $NOM_PROG - saisir les deplacements Gmsh issus d un calcul sur un maillage 1 et appliquer ces deplacements sur un maillage 2 aux noeuds communs entre les 2 maillages\n");
print "--------------------------------------------------------------------------------\n";
print "\n";
print " USAGE :\n";
print " $NOM_PROG [-h|help] [-prec PREC] fher_1 fdpl_1 fher_2 racine_fic_calcul\n";
print "\n";
print " ARGUMENTS :\n";
print " fher_1 : fichier maillage 1 (.her)\n";
print " fdpl_1 : fichier resultat Gmsh contenant la grandeur \"deplace\"\n";
print " fher_2 : fichier maillage 2 (.her)\n";
print " racine_fic_calcul : chaine de caracteres utilisee pour nommer les\n";
print " fichiers suivants qui vont etre crees :\n";
print " - racine_fic_calcul.courbes => courbe temps-deplacement par noeud\n";
print " - racine_fic_calcul.lis => listes de references par noeud\n";
print " - racine_fic_calcul.cl => conditions de blocage\n";
print " - racine_fic_calcul.TYPE5 => chargement global de TYPE5\n";
print " (voir doc herezh : typecharge)\n";
print "\n";
print " OPTIONS :\n";
print " -prec PREC : changer la precision sur les coordonnes des noeuds pour rechercher\n";
print " les noeuds communs entre maillage fher_1 et fher_2 (par defaut : 1e-6)\n";
print "\n";
print " REMARQUE :\n";
print " Seuls les noeuds du maillage fher_2 qui sont communs avec ceux du maillage fher_1\n";
print " auront des conditions de deplacements imposes. Les autres noeuds seront libres.\n";
print "\n";
print " CONSEILS D UTILISATION DES FICHIERS racine_fic_calcul.* :\n";
print " Les fichiers crees peuvent etre inseres tels quel dans un .info via des includes \'<\'.\n";
print " 1) Dans la partie maillage, le fichier racine_fic_calcul.lis peut etre mis a\n";
print " la suite de la declaration du maillage :\n";
print " < fher_2(.her)\n";
print " < fher_2(.lis)\n";
print " < racine_fic_calcul.lis\n";
print "\n";
print " 2) le fichier racine_fic_calcul.courbes est a inserer au niveau \'les_courbes_1D\'\n";
print " 3) le fichier racine_fic_calcul.cl est a inserer au niveau \'blocages\'\n";
print " 4) le fichier racine_fic_calcul.TYPE5 est a inserer au niveau \'typecharge\' si\n";
print " on souhaite obtenir un calcul exactement aux memes instants que le calcul de\n";
print " reference. Dans ce cas, verifier que les parametres de \'controle\' DELTAtMINI\n";
print " et DELTAtMAXI permettent de respecter ces temps (on peut mettre\n";
print " DELTAtMINI=1.e-90 et DELTAtMAXI = 1.e+90 et laisser herezh gerer)\n";
print "\n";
print "--------------------------------------------------------------------------------\n";
print "\n";
exit;
}
#- - - - - - - - - - - - - - - - - - -
# gestion des options
#- - - - - - - - - - - - - - - - - - -
#precision pour la recherche des noeuds confondus (1.e-6 par defaut, modifiable avec option -prec)
my $PREC = 1e-6;
my $opt;
my @args;
while($#ARGV > -1) {
$opt = shift(@ARGV);
if($opt eq '-prec') {
$PREC = shift(@ARGV); ($PREC =~ /^$format_reel$/ and $PREC > 0) or die "\nErreur (prog:$NOM_PROG, option: -prec) : la precision ($PREC) doit etre un reel non nul et positif...\n\n";
}
else {
push(@args, $opt);
}
}
#- - - - - - - - - - - - - - - - - - -
# gestion des arguments obligatoires
#- - - - - - - - - - - - - - - - - - -
($#args >= 3) or die "\nErreur (prog:$NOM_PROG) : arguments manquants...\n\n";
#argument "fher_1"
my $fher_1 = shift(@args); (-e $fher_1) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_1 introuvable...\n\n";
#argument "fdpl_1"
my $fgmsh_dpl = shift(@args); (-e $fgmsh_dpl) or die "\nErreur (prog:$NOM_PROG) : fichier $fgmsh_dpl introuvable...\n\n";
#argument "fher_2"
my $fher_2 = shift(@args); (-e $fher_2) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_2 introuvable...\n\n";
#argument "racine_fic_calcul"
my $racine_fcalcul = shift(@args);
return (fher_1 => $fher_1, fgmsh_dpl => $fgmsh_dpl, fher_2 => $fher_2, racine_fcalcul => $racine_fcalcul, PREC => $PREC);
}
sub etape1(%) {
%_ = @_;
my ($fher_1, $fher_2) = @_{qw(fher_1 fher_2)};
#########################################################################################################################
#
# ETAPE 1
#
# on lit les maillages. Ce qui nous interesse, ce sont les coordonnees des noeuds.
# elles seront contenues dans $ref_noeuds_1 et $ref_noeuds_2
# $ref_noeuds_1 (maillage 1) et $ref_noeuds_2 (maillage 2) pointent vers un tableau de la forme :
# $ref_noeuds_1/2->[i][0] => coordonnee x du noeud i
# $ref_noeuds_1/2->[i][1] => coordonnee y du noeud i
# $ref_noeuds_1/2->[i][2] => coordonnee z du noeud i
#
# remarques : 1) $nb_noeuds_1/2 => nombre de noeuds dans le maillage 1 ou 2
# 2) $nb_elts_1/2 et $ref_elements_1/2 => inutiles (jamais utilises par la suite)
#
#########################################################################################################################
my ($nb_noeuds_1, $ref_noeuds_1,
$nb_elts_1, $ref_elements_1) = lecture_mail_her($fher_1);
my ($nb_noeuds_2, $ref_noeuds_2,
$nb_elts_2, $ref_elements_2) = lecture_mail_her($fher_2);
return (nb_noeuds_1 => $nb_noeuds_1, ref_noeuds_1 => $ref_noeuds_1, nb_elts_1 => $nb_elts_1, ref_elements_1 => $ref_elements_1,
nb_noeuds_2 => $nb_noeuds_2, ref_noeuds_2 => $ref_noeuds_2, nb_elts_2 => $nb_elts_2, ref_elements_2 => $ref_elements_2);
}
sub etape2(%) {
%_ = @_;
my ($nb_noeuds_1, $ref_noeuds_1, $nb_noeuds_2, $ref_noeuds_2, $PREC) = @_{qw(nb_noeuds_1 ref_noeuds_1 nb_noeuds_2 ref_noeuds_2 PREC)};
#########################################################################################################################
#
# ETAPE 2
#
# on recherche les noeuds communs aux 2 maillages
# le tableau @tab_corresp_noeud_1_2 contiendra la correspondance entre les 2 maillages sous la forme :
# $tab_corresp_noeud_1_2[i] = j => le noeud i du maillage 1 correpsond au noeud j du maillage 2
#
#
# d un point de vue algorithme/strategie, ce n est pas efficace de tester les coordonnes de chaque noeud du maillage 1 et de comparer
# aux noeuds du maillage 2 (le temps explose quand le nombre de noeuds est grand).
# donc, on va "pre-macher" le travail :
# 1) pour le maillage 1, on cree des tables de hashage (%TAB_MAIL_1_COORD_X/Y/Z) dont les cles seront les coordonnes X/Y/Z arrondies a la decimale correspondant
# a la precision $PREC sous la forme :
# @{$TAB_MAIL_1_COORD_X/Y/Z{valeur coordonne arrondie}} = (liste des noeuds ayant cette coordonnee)
#
# 2) on teste les coordonnees de chaque noeud du maillage 2 et on regarde si une cle de %TAB_MAIL_1_COORD_X/Y/Z pourrait correspondre.
# si oui, on teste chaque noeud de la liste @{$TAB_MAIL_1_COORD_Z{valeur coordonne}} pour voir si les coordonnees
# correspondent
# si oui => on etablit la correspondance $tab_corresp_noeud_1_2[i] = j
# et dans la foulee, on en profite pour dresser une liste des noeuds du maillage 2 qui seront a traiter plus tard => @liste_noeuds_2_avec_dpl_imposes (signifiant : "liste des noeuds du maillage 2 qui vont avoir des deplacements imposes")
#
#########################################################################################################################
my @tab_corresp_noeud_1_2; for(my $i=1; $i<=$nb_noeuds_1; $i++) {$tab_corresp_noeud_1_2[$i] = 0;}
my @liste_noeuds_2_avec_dpl_imposes;
my %TAB_MAIL_1_COORD_X;
my %TAB_MAIL_1_COORD_Y;
my %TAB_MAIL_1_COORD_Z;
my $nb_decimales = return_nb_decimales($PREC);#nombre de decimales pour la conversion des coordonnees en string (on utilise $PREC pour fixer le nombre de decimales)
print "Recherche des noeuds communs...\n";
#
# remarque : les operations d arrondi ci-dessous pourrait etre refaites en utilisant le package Math::Round
#
for(my $i=1; $i<=$nb_noeuds_1; $i++) {
$_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][0]);
push(@{$TAB_MAIL_1_COORD_X{$_}}, $i);
$_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][1]);
push(@{$TAB_MAIL_1_COORD_Y{$_}}, $i);
$_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][2]);
push(@{$TAB_MAIL_1_COORD_Z{$_}}, $i);
}
my $coord_char;
for(my $i=1; $i<=$nb_noeuds_2; $i++) {
$coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][0]);
next if(not defined($TAB_MAIL_1_COORD_X{$coord_char}));
$coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][1]);
next if(not defined($TAB_MAIL_1_COORD_Y{$coord_char}));
$coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][2]);
next if(not defined($TAB_MAIL_1_COORD_Z{$coord_char}));
foreach my $noeud_1 (@{$TAB_MAIL_1_COORD_Z{$coord_char}}) {
next if(abs($ref_noeuds_2->[$i][0] - $ref_noeuds_1->[$noeud_1][0]) > $PREC);
next if(abs($ref_noeuds_2->[$i][1] - $ref_noeuds_1->[$noeud_1][1]) > $PREC);
next if(abs($ref_noeuds_2->[$i][2] - $ref_noeuds_1->[$noeud_1][2]) > $PREC);
$tab_corresp_noeud_1_2[$noeud_1] = $i;
push(@liste_noeuds_2_avec_dpl_imposes, $i);
last;
}
}
%TAB_MAIL_1_COORD_X = ();
%TAB_MAIL_1_COORD_Y = ();
%TAB_MAIL_1_COORD_Z = ();
print "nombre de noeuds communs aux 2 maillages : ", $#liste_noeuds_2_avec_dpl_imposes+1, "\n";
return (liste_noeuds_2_avec_dpl_imposes => \@liste_noeuds_2_avec_dpl_imposes, tab_corresp_noeud_1_2 => \@tab_corresp_noeud_1_2);
}
sub read_dpl($%) {
my ($fgmsh_dpl, %opt) = @_;
my $nb_noeuds = $opt{all};
my $filter = $opt{filter};
my (@liste_temps, @table_dpl_1, %liste_dpl);
#my (@liste_temps, @liste_dpl_UX, @liste_dpl_UY, @liste_dpl_UZ, @table_dpl_1);
open(FIC, "<$fgmsh_dpl");
my $no_node = 0;
while(<FIC>) {last if(/^\s*\$NodeData\s*$/);}
while(<FIC>) {
$no_node++;
<FIC>;<FIC>;
my $temps = <FIC>;
($temps) = $temps =~ /($format_reel)/ or
$nb_noeuds && die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fgmsh_dpl pour le \$NodeData no $no_node...\n\n";
if ($nb_noeuds) {
print " verification deplacements au temps : $temps\n" if $verbose;
push(@liste_temps, $temps);
}
my $nb_lines = <FIC>; chomp $nb_lines; <FIC> while $nb_lines--;
while(<FIC>) {
last if(/^\s*\$NodeData\s*$/);
chomp;
(my ($noeud_lu, $UX, $UY, $UZ) = split /\s+/) >= 4 or next;
if ($nb_noeuds) {
$table_dpl_1[$noeud_lu] = [ $UX, $UY, $UZ ];
}
elsif (!@$filter || grep $noeud_lu == $_, @$filter) {
push @{$liste_dpl{$noeud_lu}}, [ $UX, $UY, $UZ ];
}
}
if ($nb_noeuds) {
#verif de la lecture des deplacements
foreach my $i (1 .. $nb_noeuds) {
(defined($table_dpl_1[$i][0]) and defined($table_dpl_1[$i][1]) and defined($table_dpl_1[$i][2]))
or die "\nErreur (prog:$NOM_PROG) : deplacement non defini au temps $temps pour le noeud $i...\n\n";
}
}
}
close(FIC);
return $nb_noeuds ? \@liste_temps : \%liste_dpl;
}
#########################################################################################################################
#
# ETAPE 3
#
#
# verif prealable des deplacements dans le fichier $fgmsh_dpl
# (on s assure que les deplacements soient valides avant de creer tout un tas de fichiers temporaires qui ne seraient pas effaces a cause d un "die")
#
# cette etape est un peu longue (c est pas la pire), mais me parait necessaire
#
#########################################################################################################################
sub etape3(%) {
%_ = @_;
my ($fgmsh_dpl, $nb_noeuds_1) = @_{qw(fgmsh_dpl nb_noeuds_1)};
print "Verification des deplacements...\n";
return temps => read_dpl($fgmsh_dpl, all => $nb_noeuds_1);
}
#########################################################################################################################
#
# ETAPE 4
#
#
#
# creation de fichiers temporaires dans lesquels on va stocker les courbes temps-deplacement de chaque noeud de la liste @$liste_noeuds_2_avec_dpl_imposes
#
# en gros, on cree autant de fichiers que de noeuds communs aux 2 maillages pour X, Y et Z (donc => 3 fois $#$liste_noeuds_2_avec_dpl_imposes+1 fichiers)
#
# inutile de decrire le contenu de ces fichiers. Juste peut-etre dire qu ils vont principalement contenir une suite de lignes de la forme :
# Coordonnee dim= 2 valeur_temps valeur_deplacement
#
#
#
# remarque : a partir de cette etape, on capture le signal d interruption $SIG{INT} pour effacer les fichiers temporaires
# avant de quitter
#
#
#
# c est cette etape qui est tres lente car en plus de la lecture du fichier fdpl_1 (similairement a l ETAPE 3), il y a de
# nombreux acces disque pour ecrire les fichiers temporaires (et peut-etre d autres choses qui m echappent ???)
# c est cette etape qu il faut ameliorer et/ou paralleliser
#
#########################################################################################################################
sub etape4(%) {
%_ = @_;
my ($nb_noeuds_1, $fgmsh_dpl, $liste_noeuds_2_avec_dpl_imposes, $array_temps, $tab_corresp_noeud_1_2, $racine_fcalcul) =
@_{qw(nb_noeuds_1 fgmsh_dpl liste_noeuds_2_avec_dpl_imposes temps tab_corresp_noeud_1_2 racine_fcalcul)};
#liste des noms de fichiers temporaires
my @liste_fic_tmp_UX;
my @liste_fic_tmp_UY;
my @liste_fic_tmp_UZ;
#petite bidouille pour etre sur de creer des fichiers qui n existent pas et ayant tous la meme racine
# (serait sans doute mieux fait avec le package File::Temp)
my $racine_commune = $NOM_PROG.rand(99999).rand(99999);
my @fic_tmp = glob("$racine_commune*"); while($#fic_tmp > -1) {$racine_commune = $NOM_PROG.rand(99999).rand(99999); @fic_tmp = glob("$racine_commune*");}
my $ctrl_c_cb = sub {
#efface eventuellement les fichiers temporaires avant de sortir avec ctrl-c
# (on laisse le choix a l utilisateur d effacer les fichiers ou pas)
my $choix = 0;
while(($choix ne "o") and ($choix ne "n")) {
print "Voulez-vous effacer les fichiers temporaires temps-deplacement ? (o/n) : ";
$choix = <STDIN>; chomp($choix);
}
if($choix eq "o") {
print " effacement des fichiers UX...\n";
system("rm -f $_") foreach @liste_fic_tmp_UX;
print " effacement des fichiers UY...\n";
system("rm -f $_") foreach @liste_fic_tmp_UY;
print " effacement des fichiers UZ...\n";
system("rm -f $_") foreach @liste_fic_tmp_UZ;
}
exit;
};
$SIG{INT} = $ctrl_c_cb;#maintenant ctrl-c executera la sub interrupt_ctrl_c (effacement des fichiers temporaires avant de sortir)
print "Initialisation des fichiers temporaires...\n";
foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
push(@liste_fic_tmp_UX, $racine_commune."_UX_$noeud");
push(@liste_fic_tmp_UY, $racine_commune."_UY_$noeud");
push(@liste_fic_tmp_UZ, $racine_commune."_UZ_$noeud");
open(Ftmp, ">$liste_fic_tmp_UX[$#liste_fic_tmp_UX]");
print Ftmp " UX_noeud_$noeud COURBEPOLYLINEAIRE_1_D\n";
print Ftmp " Debut_des_coordonnees_des_points\n";
print Ftmp " Coordonnee dim= 2 0. 0.\n" if(abs($array_temps->[0]) > 1e-11);
close(Ftmp);
open(Ftmp, ">$liste_fic_tmp_UY[$#liste_fic_tmp_UY]");
print Ftmp " UY_noeud_$noeud COURBEPOLYLINEAIRE_1_D\n";
print Ftmp " Debut_des_coordonnees_des_points\n";
print Ftmp " Coordonnee dim= 2 0. 0.\n" if(abs($array_temps->[0]) > 1e-11);
close(Ftmp);
open(Ftmp, ">$liste_fic_tmp_UZ[$#liste_fic_tmp_UZ]");
print Ftmp " UZ_noeud_$noeud COURBEPOLYLINEAIRE_1_D\n";
print Ftmp " Debut_des_coordonnees_des_points\n";
print Ftmp " Coordonnee dim= 2 0. 0.\n" if(abs($array_temps->[0]) > 1e-11);
close(Ftmp);
}
#remplissage des fichiers temporaires
print "Remplissage des fichiers temporaires...\n";
my ($noeud_1, $noeud_2, $noeud_lu, $UX, $UY, $UZ);
my $nb_noeuds_traites = 0;
my $nb_noeuds_a_traiter = @$liste_noeuds_2_avec_dpl_imposes;
#lecture du fichier deplacement fdpl_1 et saisie des deplacements pour le noeud $noeud_1
my ($liste_dpl) = read_dpl($fgmsh_dpl, filter => [ grep $tab_corresp_noeud_1_2->[$_], 1 .. $nb_noeuds_1 ] ); # read all nodes
#for(my $noeud_1=1; $noeud_1<=$nb_noeuds_1; $noeud_1++) {
foreach my $noeud_1 (keys %$liste_dpl) {
$noeud_2 = $tab_corresp_noeud_1_2->[$noeud_1];
#on ne fait pas de traitement si le noeud $noeud_1 du maillage 1 n a pas de correspondance dans le maillage 2
#next if(not $noeud_2);
$nb_noeuds_traites++;
print " traitement noeud : $nb_noeuds_traites / $nb_noeuds_a_traiter\n";
#ajout a la suite des fichiers temporaires X Y Z correspondant a ce noeud
open(F_UX, ">>$racine_commune\_UX_$noeud_2");
open(F_UY, ">>$racine_commune\_UY_$noeud_2");
open(F_UZ, ">>$racine_commune\_UZ_$noeud_2");
for(my $i=0; $i<=$#$array_temps; $i++) {
print F_UX " Coordonnee dim= 2 $array_temps->[$i] $liste_dpl->{$noeud_1}->[$i]->[0]\n";
print F_UY " Coordonnee dim= 2 $array_temps->[$i] $liste_dpl->{$noeud_1}->[$i]->[1]\n";
print F_UZ " Coordonnee dim= 2 $array_temps->[$i] $liste_dpl->{$noeud_1}->[$i]->[2]\n";
}
print F_UX " Fin_des_coordonnees_des_points\n";
print F_UY " Fin_des_coordonnees_des_points\n";
print F_UZ " Fin_des_coordonnees_des_points\n";
close(F_UX);
close(F_UY);
close(F_UZ);
}
print "\nRappel du nombre de noeuds communs aux 2 maillages : ", $#$liste_noeuds_2_avec_dpl_imposes+1, "\n\n";
#recopie des fichiers temporaires dans un seul fichier de nom $racine_fcalcul.courbes
# (on concatene tout simplement les fichiers temporaires au sein d un seul fichier, et on efface les fichiers temporaires)
print "Recopie des fichiers temporaires au sein d un seul fichier...\n";
open(FIC, ">$racine_fcalcul.courbes");
for(my $i=0; $i<=$#$liste_noeuds_2_avec_dpl_imposes; $i++) {
print FIC "\n";
open(Ftmp, "<$liste_fic_tmp_UX[$i]");
while(<Ftmp>) {print FIC $_;}
close(Ftmp);
system("rm -f $liste_fic_tmp_UX[$i]");
print FIC "\n";
open(Ftmp, "<$liste_fic_tmp_UY[$i]");
while(<Ftmp>) {print FIC $_;}
close(Ftmp);
system("rm -f $liste_fic_tmp_UY[$i]");
print FIC "\n";
open(Ftmp, "<$liste_fic_tmp_UZ[$i]");
while(<Ftmp>) {print FIC $_;}
close(Ftmp);
system("rm -f $liste_fic_tmp_UZ[$i]");
}
close(FIC);
print " > Le fichier $racine_fcalcul.courbes a ete cree (courbes temps-deplacement par noeud)...\n";
return ();
}
#########################################################################################################################
#
# ETAPE 5
#
#
#
# derniers traitements : creation de quelques fichiers supplementaires
#
# cette etape ne prend pas beaucoup de temps
#
#
#
#########################################################################################################################
sub etape5(%) {
%_ = @_;
my ($racine_fcalcul, $liste_noeuds_2_avec_dpl_imposes, $array_temps) =
@_{qw(racine_fcalcul liste_noeuds_2_avec_dpl_imposes temps)};
#creation des listes noeud pour l application des dpl imposes (creation du fichier $racine_fcalcul.lis)
print "Creation des listes de reference de noeud...\n";
open(FIC, ">$racine_fcalcul.lis");
foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
print FIC "\n";
print FIC " N_dpl_impose_$noeud $noeud\n";
}
close(FIC);
print " > Le fichier $racine_fcalcul.lis a ete cree (references de noeud pour l application des deplacements)...\n";
#creation du fichier de conditions limites en deplacement impose (creation du fichier $racine_fcalcul.cl)
print "Creation du fichier de conditions limites...\n";
open(FIC, ">$racine_fcalcul.cl");
foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
print FIC "\n";
print FIC " N_dpl_impose_$noeud \'UX= COURBE_CHARGE: UX_noeud_$noeud ECHELLE: 1.\'\n";
print FIC " N_dpl_impose_$noeud \'UY= COURBE_CHARGE: UY_noeud_$noeud ECHELLE: 1.\'\n";
print FIC " N_dpl_impose_$noeud \'UZ= COURBE_CHARGE: UZ_noeud_$noeud ECHELLE: 1.\'\n";
}
close(FIC);
print " > Le fichier $racine_fcalcul.cl a ete cree (conditions de deplacements imposes)...\n";
#creation du fichier de typecharge TYPE5 pour imposer les instants de calcul (creation du fichier $racine_fcalcul.TYPE5)
print "Creation du fichier de typecharge TYPE5...\n";
open(FIC, ">$racine_fcalcul.TYPE5");
print FIC " TYPE5 COURBEPOLYLINEAIRE_1_D\n";
print FIC " Debut_des_coordonnees_des_points\n";
print FIC " Coordonnee dim= 2 0. 1.\n" if(abs($array_temps->[0]) > 1e-11);
foreach my $temps (@$array_temps) {print FIC " Coordonnee dim= 2 $temps 1.\n";}
print FIC " Fin_des_coordonnees_des_points\n";
close(FIC);
print " > Le fichier $racine_fcalcul.TYPE5 a ete cree (typecharge de type TYPE5)...\n\n";
}
sub return_nb_decimales {
my $nombre = shift;
$nombre = abs($nombre);
my $nb_decimales = 0;
while() {
last if($nombre >= 1);
$nombre *= 10;
$nb_decimales++;
}
return $nb_decimales;
}
#----------------
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
#
# exemple d appel :
# my ($nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her");
#
# avec - $nb_noeuds : nombre de noeuds (entier)
# - $ref_tab_noeuds : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
# $ref_tab_noeuds->[no noeud][1] : coordonnee y
# $ref_tab_noeuds->[no noeud][2] : coordonnee z)
# - $nb_elts : nombre d elements (entier)
# - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'} : type d element
# @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
# - @ref_listes : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
# => $ref_listes[0] : reference vers la table de hashage des listes de noeuds => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
# $ref_listes[1] : reference vers la table de hashage des listes d aretes => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
# $ref_listes[2] : reference vers la table de hashage des listes de faces => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
# $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
#
sub lecture_mail_her {
my $fher = shift;
#------------------------
# lecture du maillage .her
#------------------------
#-lecture de noeuds
my @tab_noeuds; my $nb_noeuds;
my $no_noeud = 0;
open(Fher, "<$fher");
while(<Fher>) {
next if(not /(\d+)\s+NOEUDS/);
$nb_noeuds = $1;
last;
}
while(<Fher>) {
last if($no_noeud == $nb_noeuds);
next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);
$no_noeud = $1;
@{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
}
#-lecture des elements
my %tab_elements; my $nb_elts;
my $no_elt = 0;
while(<Fher>) {
next if(not /(\d+)\s+ELEMENTS/);
$nb_elts = $1;
last;
}
while(<Fher>) {
last if($no_elt == $nb_elts);
next if(not /^\s*\d+\s+\w+\s+\w+/);
s/^\s+//;s/\s+$//;
$_ =~ /^(\d+)\s+/;
$no_elt = $1; s/^(\d+)\s+//;
$_ =~ /\s+(\d+(?:\s+\d+)*)$/;
@{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
$tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
}
close(Fher);
#------------------------
# lecture des references (dans le .her et dans un eventuel .lis)
#------------------------
my $flis = $fher; $flis =~ s/.her$/.lis/;
my $nom_liste;
my $is_liste_en_cours;
my %listes_NOEUDS;
my %listes_ARETES;
my %listes_FACES;
my %listes_ELEMENTS;
#-dans le .her
open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(N\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*N\S+\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);
open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(A\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*A\S+\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);
open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(F\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*F\S+\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);
open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(E\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*E\S+\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);
#dans le .lis (si il existe)
if(-e $flis) {
open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(N\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*N\S+\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);
open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(A\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*A\S+\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);
open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(F\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*F\S+\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);
open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(E\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*E\S+\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);
}#if(-e $flis)
#AFFICHAGE DES LISTES DE NOEUDS
#foreach my $nom (keys(%listes_NOEUDS)) {
# print "$nom : @{$listes_NOEUDS{$nom}}\n";
#}
#AFFICHAGE DES LISTES D ARETES
#foreach my $nom (keys(%listes_ARETES)) {
# print "$nom : @{$listes_ARETES{$nom}}\n";
#}
#AFFICHAGE DES LISTES DE FACES
#foreach my $nom (keys(%listes_FACES)) {
# print "$nom : @{$listes_FACES{$nom}}\n";
#}
#AFFICHAGE DES LISTES D ELEMENTS
#foreach my $nom (keys(%listes_ELEMENTS)) {
# print "$nom : @{$listes_ELEMENTS{$nom}}\n";
#}
return($nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
\%listes_NOEUDS, \%listes_ARETES,
\%listes_FACES, \%listes_ELEMENTS);
}#sub lecture_mail_her |