#!/usr/bin/perl #!/usr/local/bin/perl use strict; use warnings; use English; use File::Basename; use threads; use threads::shared; 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 " -NBproc nb_proc : calcul parallele via thread sur nb_proc processeurs\n"; print" (par defaut : nb_proc = 1)\n"; print " attention aux capacites de la machine!!!\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 processeurs my $NB_PROC = 1;#(par defaut : 1) my $opt; my @args; while($#ARGV > -1) { $opt = shift(@ARGV); #option -prec 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"; } #option -NBproc elsif($opt eq '-NBproc') { $NB_PROC = shift(@ARGV); ($NB_PROC =~ /^\d+$/ and $NB_PROC > 0) or die "\nErreur (prog:$NOM_PROG, option: -NBproc) : le nombre de processeurs 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 @tab_corresp_noeud_2_1; for(my $i=1; $i<=$nb_noeuds_2; $i++) {$tab_corresp_noeud_2_1[$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; $tab_corresp_noeud_2_1[$i] = $noeud_1; 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 $REGEXP_QR = qr/(\d+)\s+($format_reel)\s+($format_reel)\s+($format_reel)/; my @LIGNE_TEMPS; my @INCR_LIGNE_TEMPS_POUR_NOEUD; my (@temps, $temps); my @table_dpl_1; my $nb_incr = 0; print "Verification des deplacements...\n"; open(FIC, "<$fgmsh_dpl"); while() { next if(not /^\s*\$NodeData\s*$/); $nb_incr++; $_ = ; $_ = ; $_ = ; $_ = ; /($format_reel)/ 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; $LIGNE_TEMPS[$nb_incr] = $.; print " verification deplacements au temps : $temps\n"; push(@temps, $temps); $_[0] = ; chomp; $_[1] = for(1 .. $_[0]); @table_dpl_1 = (); while() { last if(/^\s*\$EndNodeData\s*$/); next if(not /^\s*$REGEXP_QR\s*$/); $table_dpl_1[$1][0] = $2; $table_dpl_1[$1][1] = $3; $table_dpl_1[$1][2] = $4; my $noeud_1 = $1; my $noeud_2 = $tab_corresp_noeud_1_2[$noeud_1]; next if(not $noeud_2); $INCR_LIGNE_TEMPS_POUR_NOEUD[$nb_incr][$noeud_2] = $. - $LIGNE_TEMPS[$nb_incr]; } #verif de la lecture des deplacements for(my $i=1; $i<=$nb_noeuds_1; $i++) {(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); @table_dpl_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 # # ######################################################################################################################### #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 : shared = $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*");} $SIG{INT} = \&interrupt_ctrl_c;#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($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($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($temps[0]) > 1e-11); close(Ftmp); } #remplissage des fichiers temporaires print "Remplissage des fichiers temporaires...\n"; my @liste_noeuds_1_avec_dpl_imposes; for(my $noeud_1=1; $noeud_1<=$nb_noeuds_1; $noeud_1++) { 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); push(@liste_noeuds_1_avec_dpl_imposes, $noeud_1); } my $nb_noeuds_traites = 0; my $nb_noeuds_a_traiter = $#liste_noeuds_1_avec_dpl_imposes + 1; # # A PARTIR DE LA, ON UTILISE DES THREADS POUR PARALLELISER LE TRAITEMENT (autant de threads que $NB_PROC modifiable via option -NBproc) # #initialisation des threads my @communication_thread : shared;#on communique avec eux via la variable partagee @communication_thread my @thread;#liste des threads for(my $i=0; $i<$NB_PROC; $i++) { $communication_thread[$i] = 0;#initialisation de l indicateur pour ce thread $thread[$i] = threads->new(\&traitement_noeud, $i);#creation du thread } #boucle des traitements parallelises # logique : # on a une liste @liste_noeuds_1_avec_dpl_imposes de noeuds a traiter # on va affecter le traitement de chacun de ces noeuds aux threads en attente # quand un thread est en attente, son indicateur est egal a 0 => $communication_thread[no thread] == 0 # => donc, il est dispo => on lui envoie un noeud a traiter => $communication_thread[no thread] = no noeud du maillage 1 # et => ce thread va traiter le noeud et remettra l indicateur a 0 une fois fini => $communication_thread[no thread] == 0 # on fait ca jusqu a ce qu il n y ait plus de noeuds dans la liste @liste_noeuds_1_avec_dpl_imposes (on la vide peu a peu avec shift) WHILE:while($#liste_noeuds_1_avec_dpl_imposes > -1) { #recherche d un thread disponible for(my $i=0; $i<$NB_PROC; $i++) { next if($communication_thread[$i] ne '0'); $communication_thread[$i] = shift(@liste_noeuds_1_avec_dpl_imposes); $nb_noeuds_traites++; print " traitement noeud : $nb_noeuds_traites / $nb_noeuds_a_traiter\n"; next WHILE;#on recommence un tour de while avec un nouveau noeud } #si on arrive la, c est que tous les threads sont actuellement occupes => petite pause avant de rechecker les threads select(undef,undef,undef,0.1); } # # fin du traitement parallelise => on termine proprement en 2 etapes # 1- on s assure que les traitements sont termines # 2- on quitte les threads et on les "join" # # etape 1- on attend que tous les threads aient termine leur traitement en cours WHILE2:while() { select(undef,undef,undef,0.1); for(my $i=0; $i<$NB_PROC; $i++) { next WHILE2 if($communication_thread[$i] ne '0'); } last; } # etape 2- on envoie 'quit' a tous les threads et on attend proprement leur fin (join) for(my $i=0; $i<$NB_PROC; $i++) { $communication_thread[$i] = 'quit'; $thread[$i]->join; } #sub de traitement via un thread (cette subroutine est ecrite ici avec une bonne indentation au lieu d etre mis a la fin comme les autres... car c est pas vraiment une sub normale) # rappel : cette sub est dedie a etre appelee par un thread et n est viable que si @communication_thread est "shared" (sinon catastrophe!!) sub traitement_noeud { my $no_thread = shift; #le thread attend une demande de traitement tant que l indicateur 'quit' n a pas ete envoye while($communication_thread[$no_thread] ne 'quit') { #le thread attend une demande de traitement (c a d un indicateur egal a un numero de noeud) while($communication_thread[$no_thread] eq '0') {select(undef,undef,undef,0.1);} #on verifie si eventuellement il n y a pas un 'quit' d envoye last if($communication_thread[$no_thread] eq 'quit'); #on traite le noeud $noeud_1 du maillage 1 ... my $noeud_1 = $communication_thread[$no_thread]; # ... correspondant au noeud $noeud_2 du maillage 2 my $noeud_2 = $tab_corresp_noeud_1_2[$noeud_1]; #ajout a la suite des fichiers temporaires X Y Z correspondant a ce noeud open(my $F_UX, ">>$racine_commune\_UX_$noeud_2"); open(my $F_UY, ">>$racine_commune\_UY_$noeud_2"); open(my $F_UZ, ">>$racine_commune\_UZ_$noeud_2"); #lecture du fichier deplacement fdpl_1 et saisie des deplacements pour le noeud $noeud_1 open(my $Hlocal_fdpl, "<$fgmsh_dpl"); local $.;#il faut localiser $. sinon c est le bazar vu que plusieurs threads ouvrent ce fichier #boucle sur les increments : # connaissant le numero de ligne du temps pour chaque increment ($LIGNE_TEMPS[no incr]) # et connaissant le nombre de lignes a lire en plus de $INCR_LIGNE_TEMPS_POUR_NOEUD[no incr][noeud 2] pour atteindre le noeud $noeud_1 for(my $no_incr=1; $no_incr<=$nb_incr; $no_incr++) { my $ligne_temps = $LIGNE_TEMPS[$no_incr]; my $ligne_actuelle = $.; for(my $i=1; $i<=($ligne_temps-$ligne_actuelle)-1; $i++) {<$Hlocal_fdpl>;} $_ = <$Hlocal_fdpl>; /($format_reel)/; $temps = $1; for(my $i=1; $i<=$INCR_LIGNE_TEMPS_POUR_NOEUD[$no_incr][$noeud_2]-1; $i++) {<$Hlocal_fdpl>;} $_ = <$Hlocal_fdpl>; #/^\s*$REGEXP_QR\s*$/; my ($noeud_lu, $UX, $UY, $UZ) = split; ($noeud_lu == $noeud_1) or do { print "Erreur (prog:$NOM_PROG) : pb dans la recherche du noeud $noeud_1 du maillage 1 au temps $temps (incr=$no_incr)...\n\n"; interrupt_ctrl_c(); }; print $F_UX " Coordonnee dim= 2 $temps $UX\n"; print $F_UY " Coordonnee dim= 2 $temps $UY\n"; print $F_UZ " Coordonnee dim= 2 $temps $UZ\n"; } close($Hlocal_fdpl); 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); $communication_thread[$no_thread] = 0; }#fin boucle thread : while($communication_thread[$no_thread] ne 'quit') print "fin thread no $no_thread ...\n"; }#sub traitement_noeud # # L UTILISATION DE THREADS S ARRETE ICI # 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() {print FIC $_;} close(Ftmp); system("rm -f $liste_fic_tmp_UX[$i]"); print FIC "\n"; open(Ftmp, "<$liste_fic_tmp_UY[$i]"); while() {print FIC $_;} close(Ftmp); system("rm -f $liste_fic_tmp_UY[$i]"); print FIC "\n"; open(Ftmp, "<$liste_fic_tmp_UZ[$i]"); while() {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"; ######################################################################################################################### # # 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 # # # #efface eventuellement les fichiers temporaires avant de sortir avec ctrl-c # (on laisse le choix a l utilisateur d effacer les fichiers ou pas) sub interrupt_ctrl_c { my $choix = 0; while(($choix ne "o") and ($choix ne "n")) { print "Voulez-vous effacer les fichiers temporaires temps-deplacement ? (o/n) : "; $choix = ; 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; } 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() { next if(not /(\d+)\s+NOEUDS/); $nb_noeuds = $1; last; } while() { 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() { next if(not /(\d+)\s+ELEMENTS/); $nb_elts = $1; last; } while() { 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() { 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() { 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() { 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() { 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() { 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() { 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() { 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() { 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