améliorer performance script

Citation:

---

Envoyé par seagull

non, on pourrait remplacer $format_reel par \S+. J'ai mis $format_reel par habitude mais ça sert à rien. La structure d'un NodeData est toujours la même comme cet exemple :
$NodeData
1 => nombre de lignes d'information qui vont suivre (en l'occurence 1 seule => "deplace")
"deplace" => la fameuse ligne annoncée
1 => nombre de lignes d'information qui vont suivre (en l'occurence 1 seule => un réel qui est le temps)
0.001 => le fameux réel annoncé
3 => nombre de lignes d'information qui vont suivre (en l'occurence 3 => les 2 premières je ne sais plus mais la 3ème est le nombre de noeuds)
1
3
3362 => le nombre de noeuds
1 x y z
2 x y z
.
.
3362 x y z

---

Donc pour la ligne "le fameux réel annoncé", on pourrait "prendre la ligne" sans autre forme de procès (et ne pas contrôler qu'il s'agit bien d'un réel, c'est ça ? (ça évite d'extraire le réel avec une regexp, alors qu'un simple chomp suffit).
Idem pour x, y, z (que j'ai déjà remplacé par un split /\s+/ :)

La version 8 :

Code:

---

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

#!/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) ## 08 - OPTIM 7: suppression de l'utilisation des fichiers temporaires ## TODO : traitement par lot en tenant compte de la mémoire consommée.   $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 $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);   ######################################################################################################################### # # 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... # ######################################################################################################################### sub etape0() {   #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); }   ######################################################################################################################### # # 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) # ######################################################################################################################### sub etape1(%) { %_ = @_; my ($fher_1, $fher_2) = @_{qw(fher_1 fher_2)};   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); }   ######################################################################################################################### # # 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") # ######################################################################################################################### 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)};   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; } } 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);   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; my @labels_U = qw(UX UY UZ);   print "Initialisation des fichiers temporaires...\n"; foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) { foreach my $label_U (@labels_U) { push @{$liste_fic{$noeud}->{$label_U}}, " ${label_U}_noeud_$noeud COURBEPOLYLINEAIRE_1_D\n"; push @{$liste_fic{$noeud}->{$label_U}}, " Debut_des_coordonnees_des_points\n"; push @{$liste_fic{$noeud}->{$label_U}}, " Coordonnee dim= 2 0. 0.\n" if(abs($array_temps->[0]) > 1e-11); } }   #remplissage des fichiers temporaires print "Remplissage des fichiers temporaires...\n";   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) { my $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 for(my $i=0; $i<=$#$array_temps; $i++) { my $index_U = 0; for my $label_U (@labels_U) { push @{$liste_fic{$noeud_2}->{$label_U}}, " Coordonnee dim= 2 $array_temps->[$i] $liste_dpl->{$noeud_1}->[$i]->[$index_U]\n"; $index_U++; } } for my $label_U (@labels_U) { push @{$liste_fic{$noeud_2}->{$label_U}}, " Fin_des_coordonnees_des_points\n"; } }   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 my $FIC, ">", "$racine_fcalcul.courbes"; foreach my $noeud (sort { $a <=> $b } keys %liste_fic) { foreach my $label_U (@labels_U) { print { $FIC } "\n"; print { $FIC } @{$liste_fic{$noeud}->{$label_U}}; } } 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

---

Philou67430 :
Je suis étonné par la manière dont tu passes les arguments successivement aux subroutines d'étape par accumulation dans un hash. C'est joli. C’est une manière de faire classique ?
J’ai du mal à piger comment les sub peuvent récupérer un hash alors qu’elle reçoivent la liste @_!!!
la forme :

Code:

---

%_ = @_;

---

était pour moi impensable. J’ai testé pour comprendre : la liste @_ contient une suite : clé, valeur, clé, valeur, etc… et quand on affecte @_ à un hash (%_), ça construit le hash!!!! Il faut l’avoir vu une fois pour y penser.
et ensuite la tournure @_{qw(…)}, pareil, il faut l’avoir vu une fois.

petite question : une fois une subroutine d’étape terminée, toutes ses variables sont détruites (libérant ainsi de la mémoire pour les étapes suivantes) ?


Bref. Merci pour ton code.

de mon côté, j’ai testé vite fait avec base de données SQLite. Je suis pour l’instant déçu car :
1. ça prend un temps considérable pour créer la base de données (il m’a fallu 10 minutes rien que pour créer les 80 premiers NodeData sur les 1644!!!! j’ai donc arrêté l’exécution)
2. ma mémoire est saturée pendant la création de cette base (et l’activité processeur de mon script descend à 25%, d’où sans doute le temps d’exécution minable)

voici mon code sur le principe du tuto de djibril http://djibril.developpez.com/tutoriels/perl/perl-dbi/. Son but est uniquement de créer la base de données deplace.db en reprenant le bloc de lecture du fichier fdpl_1.pos :

Code:

---

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

#!/usr/bin/env perl #!/usr/local/bin/perl use strict; use warnings; use English; use File::Basename;   #use DBD::SQLite; #apparemment use DBI suffit use DBI;   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 = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';   ($#ARGV == 0) or die "Erreur : 1 arg requis...\n\n"; my $fdeplace = shift(@ARGV); (-e $fdeplace) or die "Erreur : fichier $fdeplace introuvable...\n\n";   system("rm -f deplace.db"); my $BDD = DBI->connect("dbi:SQLite:dbname=deplace.db", "", "");   $BDD->do('CREATE TABLE deplace (id INTEGER AUTO_INCREMENT PRIMARY KEY, increment INTEGER, noeud INTEGER, ux REAL, uy REAL, uz REAL);') or die "pb creation table : ", $BDD->errstr, "\n";   my $insertion_donnee = $BDD->prepare('INSERT INTO deplace (id, increment, noeud, ux, uy, uz) VALUES(?, ?, ?, ?, ?, ?);') or die "pb preparation insertion donnee : ", $BDD->errstr, "\n";   my $REGEX_QR_NodeData = qr/\$NodeData/; my $nb_incr = 0; my $nb_noeuds = 0; open(FIC, "<$fdeplace"); while(<FIC>) { next if(not /$REGEX_QR_NodeData/o); $nb_incr++; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; /($format_reel)/ or die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fdeplace pour le \$NodeData no $nb_incr...\n\n"; my $temps = $1; print " enregistrement au temps : $temps\n"; $_[0] = <FIC>; chomp; $_[1] = <FIC> for(1 .. $_[0]); (not $nb_noeuds) and do { $_[1] =~ /(\d+)/o or die "\nErreur (prog:$NOM_PROG) : impossible de lire le nombre de noeuds dans le fichier $fdeplace pour le \$NodeData no $nb_incr...\n\n";; $nb_noeuds = $1; }; #on suppose que le fichier ne contient pas de surprise : donc lecture directe de $nb_noeuds lignes avec un for() for(my $i=1; $i<=$nb_noeuds; $i++) { $_ = <FIC>; @_ = split; $insertion_donnee->execute(undef, $nb_incr, @_) or die "pb insertion donnee : ", $BDD->errstr, "\n"; } } close(FIC);   $BDD->disconnect();

---

Citation:

---

Envoyé par seagull

Philou67430 :
Je suis étonné par la manière dont tu passes les arguments successivement aux subroutines d'étape par accumulation dans un hash. C'est joli. C’est une manière de faire classique ?

---

Non, ce n'est pas classique. Mais je voulais changer le moins possible tes noms de variables. Comme chaque étape était isolée, les variables qui étaient globales sont devenues locales. J'ai donc utilisé un hash global pour les récupérer lors de l'appel des étapes, ainsi que pour les transmettre lors de l'appel (à la manière de paramètres nommés).
Ainsi, j'avais moins de risque de m'emmêler les pinceaux.

Citation:

---

J’ai du mal à piger comment les sub peuvent récupérer un hash alors qu’elle reçoivent la liste @_!!!
la forme :

Code:

---

%_ = @_;

---

était pour moi impensable. J’ai testé pour comprendre : la liste @_ contient une suite : clé, valeur, clé, valeur, etc… et quand on affecte @_ à un hash (%_), ça construit le hash!!!! Il faut l’avoir vu une fois pour y penser.

---

Il n'y a en fait rien de compliqué à comprendre %_ = @_ : c'est comme initialiser un hash avec une liste.

Code:

---

my %hash = (toto => 1, titi => 2);

---

est exactement identique à :

Code:

---

1 2	my @array = (toto, 1, titi, 2); my %hash = @array;

---

En revanche, on peut se poser la question du résultat de :

Code:

---

@_ = %_;

---

Pourtant, c'est aussi assez simple à comprendre, ça revient exactement à la magie des passages de paramètres "nommés" :
a(toto => 1, titi => 2);
devient dans la fonction a :

Code:

---

1 2 3 4

sub a { my %param = @_; print "toto = $param{toto}\n"; }

---

Citation:

---

et ensuite la tournure @_{qw(…)}, pareil, il faut l’avoir vu une fois.

---

OK, je suis d'accord que la syntaxe d'un slice d'éléments d'un hash n'est pas simple ... ça devrait s'améliorer avec perl6.

Citation:

---

petite question : une fois une subroutine d’étape terminée, toutes ses variables sont détruites (libérant ainsi de la mémoire pour les étapes suivantes) ?

---

Toutes les variables "my" dont la référence n'est pas retournée par la fonction étape sont détruites. Les autres, sont conservées tant que %opt est défini (c'est à dire jusqu'à la fin du programme).

Je reprendrais la suite des évolutions lundi. En attendant, je t'invite à essayer ma version 8 (la dernière) avec des fichiers de données plus gros, histoire de voir si ça passe toujours chez toi. Dans la prochaine étape, j'ai prévu des surveiller la conso mémoire du programme.

Bon week-end à tous.

Citation:

---

Envoyé par seagull

de mon côté, j’ai testé vite fait avec base de données SQLite. Je suis pour l’instant déçu car :
1. ça prend un temps considérable pour créer la base de données (il m’a fallu 10 minutes rien que pour créer les 80 premiers NodeData sur les 1644!!!! j’ai donc arrêté l’exécution)
2. ma mémoire est saturée pendant la création de cette base (et l’activité processeur de mon script descend à 25%, d’où sans doute le temps d’exécution minable)

---

Il y a quelque chose qui ne va pas, car SQLite est réputé très rapide. Il faut sans doute explorer les options (autocommit, etc.) pour comprendre. Par ailleurs, pour tirer parti de SQLite, il faudra que tu ajoutes un index sur l'ID, pour permettre une recherche rapide sur ce champ.

bon. j’ai bien fait mumuse ce week-end.

1) j’ai testé la version de philou67430
sur ma machine, pour 86 noeuds, j’ai cet ordre de grandeur : environ 55s.

Pour aller plus loin, j’ai testé avec tous les noeuds (i.e fher1.her en 3eme argument i.e 3362 noeuds). ça passe mais c’est costaud. L’ordre de grandeur du temps d’exécution est 14min 30s. Il passe un temps fou à charger en mémoire (mais une fois fait, le traitement est très rapide). Pendant la phase de mise en mémoire, la mémoire grimpe progressivement pour atteindre environ 2500M, puis au moment où les traitements s’enclenchent, elle grimpe rapidement, pour atteindre environ 3500M (ce qui m’étonne vu que normalement il a déjà tout en mémoire). c’est bien gourmand.
A noter quand même qu’avec ma version initiale, c’est un traitement qui dure environ 2h (de mémoire, c’est peut-être plus).

2) j’ai laissé de côté les BDD pour l’instant (j’ai tenté de trouver une option pour désactiver l’autocommit qui couterait du temps sans trop savoir exactement ce que ça veut dire. bref…)

3) j’ai testé une solution combinant seek-tell avec la méthode du split de fichier… et là, j’ai envie de dire bingo!
dans les grandes lignes, voici les nouveautés :
a- je profite de l’ETAPE 3 pour construire une table de tell me permettant de me positionner rapidement dans le fichier d’entrée. Le split est géré à ce niveau, c’est-à-dire que je ne recopie pas le fichier en plusieurs mais le split est "simulé" en enregistrant plus de tell selon l’option -split que j’ai rajoutée (i.e un split par NodeData + 1 split tous les N noeuds au sein d’un NodeData).

b- dans l’ETAPE 4, le fichier d’entrée n’est ouvert qu’une seule fois et on se positionne dedans grâce à seek en fonction du NodeData et du numéro de noeud. J’ai constaté qu’un split tous les 20 noeuds était satisfaisant (pas ou peu de gain en dessous de cette valeur).
Il n’y a plus d’écriture des milliers de fichiers temporaires (seulement 3 fichiers temporaires + recopie directe dans le fichier final avant de passer à un nouveau noeud)

c- à signaler que dans l’ETAPE 3 de vérification, j’ai allégé la vérif en ne vérifiant la présence des données que pour le noeud 1 et le dernier noeud (si c'est ok pour le premier et le dernier, il y a quand même de fortes chances que ce soit ok pour les autres).

d- j’ai utilisé //o dans les regex partout où c’était possible et privilégié split

voici les ordres de grandeur de temps d’exécution :
pour 86 noeuds :
- sans split => 23s
- avec -split 500 => 17s
- avec -split 200 => 8-9s
- avec -split 20 => 4-5s
***** edit : j'ai oublié de préciser que la modif de l'ETAPE 3 de vérif fait tomber le temps de la seule ETAPE 3 de 45s à 2s, ce qui fait qu'à mon avis la version de philou67430 devrait avoir un temps de l'ordre de grandeur de ma version -split 200 voire moins si elle incorporait cette modif. *****

pour 3362 noeuds :
- avec -split 20 => 1min 37s (mémoire : 32M)
- avec -split 10 => 1min 30s (mémoire : 42M)

Efficace et vraiment peu gourmand en mémoire. On peut faire tourner autre chose en même temps sans problème. Si la version initiale demandait 2h, on est sur un facteur 60 en gain. Que ce soit en chargeant en mémoire ou créant une base de données, la phase de préparation risque d’être longue. Avec la méthode tell-seek, le programme commence presque immédiatement à écrire le fichier final et ça s’avère payant.

j’ai également testé avec multi-threading mais le gain de temps n’est pas significatif étant donné que le traitement d’un noeud à l’ETAPE 4 ne prend plus énormément de temps. Du coup, 1) ma tambouille de thread est trop lourde pour être réellement bénéfique, 2) le multi-threading oblige à écrire plein de fichiers temporaires + concaténation comme dans la version initiale. J’ai réussi à descendre à 1min 20s avec 2 threads et 1min 18s avec 3 threads, ce qui montre bien que le gain est négligeable et ne vaut pas le coup d’occuper du processeur.

Voici le code de la version sans multi-threading (suivi d’un code qui permet de remettre dans l’ordre le fichier .courbes pour pouvoir comparer avec les anciennes versions) :

Code:

---

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

#!/usr/bin/env perl #!/usr/local/bin/perl use strict; use warnings; use English; use File::Basename; use File::Temp qw/tempfile/; use Text::Wrap; $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 = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';     ######################################################################################################################### # # 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) # #########################################################################################################################           ######################################################################################################################### # # 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 " -split nb_noeuds_split : nombre de noeuds pour spliter les donnees pour faciliter la\n"; print " lecture du fichier fdpl_1\n"; print " (par defaut : 20)\n"; print " cette option modifie la rapidite d execution. Plus nb_noeuds\n"; print " est petit, plus le traitement sera rapide avec neanmoins un\n"; print " surcout de stockage (besoin en memoire vive)\n"; print "\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; #nombre de noeuds pour split les donnees (20 par defaut) my $nb_noeuds_split = 20;   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"; } elsif($opt eq '-split') { $nb_noeuds_split = shift(@ARGV); ($nb_noeuds_split =~ /^\d+$/ and $nb_noeuds_split >= 1) or die "\nErreur (prog:$NOM_PROG, option: -split) : le nombre de noeuds par split ($nb_noeuds_split) doit etre un entier 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);             ######################################################################################################################### # # 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);               ######################################################################################################################### # # 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";     ######################################################################################################################### # # 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 # # # # ######################################################################################################################### my (@TEMPS, $temps); my @TAB_TELL_NODEDATA; my $nb_tell_par_nodedata = int($nb_noeuds_1/$nb_noeuds_split) + 1; my $nb_incr = 0; print "Verification des deplacements...\n"; open(FIC, "<$fgmsh_dpl"); while(<FIC>) { next if(not /^\s*\$NodeData/o); $nb_incr++; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; /($format_reel)/o or die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n"; $temps = $1; print " verification deplacements au temps : $temps\n"; push(@TEMPS, $temps); $_[0] = <FIC>; chomp; $_[1] = <FIC> for(1 .. $_[0]); push(@{$TAB_TELL_NODEDATA[$#TEMPS]}, tell(FIC)); my $ligne = <FIC>; $ligne =~ (/^\s*1\s+$format_reel\s+$format_reel\s+$format_reel/o) or die "\nErreur (prog:$NOM_PROG) : impossible de lire le deplacement du noeud 1 dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n"; my $borne_fin = ($nb_noeuds_1 < $nb_noeuds_split) ? $nb_noeuds_1 : $nb_noeuds_split; for(my $i=2; $i<=$borne_fin; $i++) {$ligne = <FIC>;} for(my $nb_tell=2; $nb_tell<=$nb_tell_par_nodedata; $nb_tell++) { push(@{$TAB_TELL_NODEDATA[$#TEMPS]}, tell(FIC)); $borne_fin = ($nb_noeuds_1 < $nb_tell*$nb_noeuds_split) ? $nb_noeuds_1-($nb_tell-1)*$nb_noeuds_split : $nb_noeuds_split; for(my $i=1; $i<=$borne_fin; $i++) {$ligne = <FIC>;} } $ligne =~ (/^\s*$nb_noeuds_1\s+$format_reel\s+$format_reel\s+$format_reel/o) or die "\nErreur (prog:$NOM_PROG) : impossible de lire le deplacement du noeud $nb_noeuds_1 dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n"; } close(FIC);       ######################################################################################################################### # # 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 # # ######################################################################################################################### #fichiers temporaires UX UY UZ my $ftmp_UX; ($_, $ftmp_UX) = tempfile("tmp_dpl_UX_XXXXXX"); my $ftmp_UY; ($_, $ftmp_UY) = tempfile("tmp_dpl_UY_XXXXXX"); my $ftmp_UZ; ($_, $ftmp_UZ) = tempfile("tmp_dpl_UZ_XXXXXX");     $SIG{INT} = sub {#maintenant ctrl-c effacera les fichiers temporaires avant exit system("rm -f $ftmp_UX $ftmp_UY $ftmp_UZ"); exit; };     #remplissage du fichier .courbes print "Remplissage du fichier $racine_fcalcul.courbes ...\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 + 1;   open(FCOURBE, ">$racine_fcalcul.courbes");   open(FIC, "<$fgmsh_dpl"); for(my $noeud_1=1; $noeud_1<=$nb_noeuds_1; $noeud_1++) { $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 (noeud_1 = $noeud_1)\n";     #ecriture dans des fichiers temporaires avant recopie dans fichier final open(F_UX, ">$ftmp_UX"); open(F_UY, ">$ftmp_UY"); open(F_UZ, ">$ftmp_UZ"); for(my $i=0; $i<=$#TEMPS; $i++) { my $no_tell = int(($noeud_1-1)/$nb_noeuds_split); seek(FIC, $TAB_TELL_NODEDATA[$i][$no_tell], 0); for(my $j=$no_tell*$nb_noeuds_split+1; $j<=$noeud_1-1; $j++) {<FIC>;} $_ = <FIC>; ($_, $UX, $UY, $UZ) = split; print F_UX "$TEMPS[$i] $UX\n"; print F_UY "$TEMPS[$i] $UY\n"; print F_UZ "$TEMPS[$i] $UZ\n"; } close(F_UX); close(F_UY); close(F_UZ);   #ecriture dans le fichier final open(F_U, "<$ftmp_UX"); print FCOURBE "\n"; print FCOURBE " UX_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n"; print FCOURBE " Debut_des_coordonnees_des_points\n"; print FCOURBE " Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11); while(<F_U>) {print FCOURBE " Coordonnee dim= 2 $_";} close(F_U); print FCOURBE " Fin_des_coordonnees_des_points\n\n";   open(F_U, "<$ftmp_UY"); print FCOURBE " UY_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n"; print FCOURBE " Debut_des_coordonnees_des_points\n"; print FCOURBE " Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11); while(<F_U>) {print FCOURBE " Coordonnee dim= 2 $_";} close(F_U); print FCOURBE " Fin_des_coordonnees_des_points\n\n";   open(F_U, "<$ftmp_UZ"); print FCOURBE " UZ_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n"; print FCOURBE " Debut_des_coordonnees_des_points\n"; print FCOURBE " Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11); while(<F_U>) {print FCOURBE " Coordonnee dim= 2 $_";} close(F_U); print FCOURBE " Fin_des_coordonnees_des_points\n"; } close(FIC); close(FCOURBE); system("rm -f $ftmp_UX $ftmp_UY $ftmp_UZ");   print "\nRappel du nombre de noeuds communs aux 2 maillages : ", $#liste_noeuds_2_avec_dpl_imposes+1, "\n\n";   print " > Le fichier $racine_fcalcul.courbes a ete cree (courbes temps-deplacement par noeud)...\n";       ######################################################################################################################### # # ETAPE 5 # # # # derniers traitements : creation de quelques fichiers supplementaires # # cette etape ne prend pas beaucoup de 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($TEMPS[0]) > 1e-11); foreach $temps (@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";                       # # # # le script s arrete la. Le reste, c est la definition des subroutines # # #       #retourne le nombre de decimales d un reel # entree : un reel # sortie : nombre de decimale (un entier) 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

---

Code de tri du fichier .courbes (en reprenant une stratégie tell-seek car le fichier .courbes peut être gros) :

Code:

---

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

#!/usr/bin/env perl use strict; use warnings;     my $fcourbes = shift(@ARGV); (-e $fcourbes) or die "\nErreur : fichier $fcourbes introuvable...\n\n";   my @liste_noeud; my @TAB_TELL; open(FIC, "<$fcourbes") or die "pb fichier $fcourbes : $!\n"; while() { my $tell = tell(FIC); last if(not $_ = <FIC>); next if(not /UX_noeud_(\d+)/o); push(@liste_noeud, $1); $TAB_TELL[$liste_noeud[$#liste_noeud]] = $tell; } close(FIC); @liste_noeud = sort {$a <=> $b} @liste_noeud;   open(FIC, "<$fcourbes"); open(FIC2, ">$fcourbes.tri"); foreach my $noeud (@liste_noeud) { print FIC2 "\n"; seek(FIC, $TAB_TELL[$noeud], 0); $_ = <FIC>; print FIC2; my $nb_fin_coord = 0; while(<FIC>) { $nb_fin_coord++ if(/Fin_des_coor/); last if(/UX_noeud_/o); print FIC2; last if($nb_fin_coord == 3); } } close(FIC); close(FIC2);   print "Le fichier $fcourbes.tri a ete cree...\n\n";

---

Dans ma version "tout en mémoire", la fin de chargement du fichier fdpl_1.pos ne signifie pas la fin de l'occupation mémoire : en effet, la construction des fichiers temporaire est également mise en mémoire au lieu d'être "écrite" dans des fichiers réel puis concaténés. C'est la raison pour laquelle la mémoire continue de monter jusqu'à la libération finale (c'est à dire que le fichier .courbes est écrit).

ah oui effectivement je n'avais pas compris.

Je suppose que l'on peut arrêter là les investigations ? en tout cas, ça m'a intéressé.

intérêt partagé. J'ai appris plein de trucs.

si je suis intéressé par les BDD, j'ouvrirai un autre sujet dédié.

compte-tenu de la demande initiale, je ne sais pas si on peut mettre [résolu]. En tout cas, on pourrait mettre [satisfait] :-)