#!/usr/bin/perl use strict; ################################################################################################## # script pour passer du format de maillage genere par gmsh au format lu par herezh++ # # version 1: version initiale # # version 1.1: 30 avr 2008 prise en compte du fait qu'il peut ne pas y avoir de reference # # de type chaine de caractères # # version 1.2: 9 mai 2008 Dans le cas où on ne conserve pas les éléments noeuds, on conserve # # quand m^eme les références associées. Au niveau des tag on différencie entre # # 1) les physical name (c'est-à-dire les ref que l'on met # # 2) le numéro de l'entité géométrique élémentaires # # 3) le numéro de la partition de maillage # # version 1.3: 13 mai 2008 # # 1) introduction de références d'aretes et de surfaces pour les # # éléments lignes et surfaces (uniquement) # # 2) construction de références de noeuds correspondants aux refs d'éléments # # que ces éléments soient concervés ou non # # version 1.4: 23 mai 2008 # # correction d'un bug sur l'affichage du nombre total d'element # # version 1.5: 6 fevrier 2009 # # correction de la numérotation pour les éléments quadratiques # # suppression blancs et tab en debut de ligne, en lecture du .msh # # version 1.6: 13 avril 2010 - S. Bochard # # maillage msh au format 2.1 depuis gmsh-2.4 # # correction lecture references pour sorties générées par gmsh-2.4 # # version 1.7: 5 fevrier 2011 # # re-correction de la numérotation pour les éléments quadratiques # # hexaedre incomplet, introduction du nombre de pti # # version 1.8: 19 octobre 2011 - S. Bochard # # maillage msh au format 2.2 depuis gmsh-2.5 # # correction format maillage 2.1 et supérieur pour gmsh 2.4 et 2.5 # # version 1.9: 1 fevrier 2012 - G. Rio # # correction bug sur la sortie des tetraedres quadratiques # # version 2.0: 10 decembre 2012 - G. Rio # # correction bug sur la sortie des tetraedres quadratiques # # version 2.1: 15 decembre 2012 - G. Rio # # correction bug sur la sortie des tetraedres quadratiques # # version 2.2: 2 decembre 2015 - G. Rio # # ajout du nom du type d'élément, quand question nombre de pti # # version 2.3: 19 fevrier 2017 - G. Rio # # sortie sytématique du nom du fichier traité # # version 2.4: 26 novembre 2018 - G. Rio # # modification de POUT QUADRATIQUE en pout BIE2 # # version 2.5: 11 septembre 2025 - J. Troufflard # # - divers correctifs mineurs pour supprimer tous les warnings obtenus quand on # # verifie le script en faisant : perl -cw msh2her.pl # # - ajout de l element QUADRANGLE CUBIQUE # # - suppression des noeuds non references (noeuds appartenant a aucun element) # # - ajout option -axi (transformer les elements 1D/2D en elements axisymetriques)# # - ajout option -nom_ref_strict (nommer les listes de reference en respectant # # strictement les noms indiques dans le fichier # # .geo dans les "Physical Line/Surface/Volume") # # - ajout option -only_ref (permet de specifier les listes de reference que l on # # souhaite garder dans le fichier .her) # # - modif de l aide -h # ################################################################################################## my $nom; my $version = "2.5"; my $EN_TETE_MSH2ER = " ############################################################################# # # # msh2her.pl # # transformation d\'un maillage genere par le programme gmsh # # en un maillage utilisable par Herezh++ # ############################################################################# # licence GPL, gerard.rio\@univ-ubs.fr # # http://www-lg2m.univ-ubs.fr/\~rio # # version $version # ############################################################################# "; if ($ARGV[0] eq '-h') # si premier argument est -h : on donne le mode d'emploi { print ("\n"); print $EN_TETE_MSH2ER; print ("\n"); print ("\n usage: msh2her.pl "); print ("\n ----> entree interactive des noms de fichier \n"); print ("\n usage: msh2her.pl \n"); print ("\n ----> indication de la source et de la cible "); print ("\n NB: les noms de fichier peuvent avoir ou non leur extension \n"); print ("\n usage: msh2her.pl -v "); print ("\n ----> affiche la version du programme \n"); print ("\n usage: msh2her.pl -h "); print ("\n ----> information sur l'utilisation \n"); print ("\n"); print ("\n options :\n"); print ("\n -axi : convertir les element 1D et 2D en elements axi\n"); print ("\n"); print ("\n -nom_ref_strict : nommer les listes de reference en respectant strictement\n"); print (" les noms indiques dans le fichier .geo dans les \n"); print (" \"Physical Line/Surface/Volume\"\n"); print (" (suppression des suffixes _LIGNE, _SURFACE, _VOLUME)\n"); print ("\n"); print ("\n -only_ref nom_1 [... nom_N] end : ne garder que les listes de references\n"); print (" dont le nom figure dans cette option\n"); print (" (NB : terminer la liste par le mot \"end\")\n"); print ("\n\n"); exit(0); } elsif ($ARGV[0] eq '-v') # si premier argument est -v : on donne le numero de version { print ("\n msh2her.pl: version "."$version"."\n\n"); exit(0); }; #------------------- écriture de l'entete à l'écran ----------------- print ("\n"); print $EN_TETE_MSH2ER; print ("\n"); #------------------- fin écriture de l'entete à l'écran ----------------- #------------------- verif presence d options dans les arguments -------------------- #MODIF J. Troufflard : premier balayage des arguments pour recuperer d eventuelles options my $is_opt_axi = 0;#indicateur de l option -axi (transformer les elements POUT, TRIANGLE, QUADRANGLE en SEG_AXI, TRIA_AXI, QUAD_AXI) my $is_opt_nom_ref_strict = 0;#indicateur de l option -nom_ref_strict (nommer les listes de reference en respectant strictement les noms utilises dans les "Physical" du fichier Gmsh .geo) my $is_opt_only_ref = 0;#indicateur de l option -only_ref (ne conserver que les listes de references indiquees en arguments) my @liste_only_ref = ();#liste des listes de reference a garder (option -only_ref ref_1 ref_2 ... ref_N end) # NB : si cette liste est vide mais que l option a ete utilise (i.e -only_ref end), aucune ref ne sera conservee my @args; while($#ARGV > -1) { my $opt = shift(@ARGV); #option -axi if($opt eq '-axi') { $is_opt_axi = 1; } #option -nom_ref_strict elsif($opt eq '-nom_ref_strict') { $is_opt_nom_ref_strict = 1; } #option -only_ref elsif($opt eq '-only_ref') { $is_opt_only_ref = 1; my $is_end = 0; while($#ARGV > -1) { $opt = shift(@ARGV); if($opt eq 'end') { $is_end = 1; last; } push(@liste_only_ref, $opt); } $is_end or die "\nErreur (opt:-only_ref) : le mot-cle \"end\" n a pas ete trouve...\n\n"; } #autre arguments else { push(@args, $opt); } } #on remet les arguments dans @ARGV pour le fonctionnement normal de msh2her.pl @ARGV = @args; #si option -only_ref : on indique sa presence avec rappel des listes de reference choisies if($is_opt_only_ref) { print "\n"; print "**option -only_ref :\n"; print " seules les listes de reference ci-dessous figureront dans le fichier .her :\n"; print " (si elles existent)\n"; if($#liste_only_ref != -1) { print " > $_\n" for @liste_only_ref; } else { print " > aucune\n"; } print "\n"; } #------------------- fin verif presence d options dans les arguments -------------------- #------------------- on s'occupe tout d'abord des fichiers -------------------- # tout d'abord on récupère le nom du fichier à traiter my $nombase; if ($ARGV[0]) # si on a un argument, c'est le nom du fichier { $nombase = $ARGV[0];} else # sinon on demande interactivement le nom du fichier { print ("\n nom du fichier ? "); $nombase = ; chomp($nombase); # on supprime le retour à la ligne }; # on supprime l'extension .msh si elle existe $nombase =~ s/\.msh//; # on ouvre le fichier msh en lecture tout d'abord, il doit donc exister my $fichier_msh = $nombase . '.msh'; open (fic_msh,$fichier_msh) || die (" \n erreur en ouverture du fichier " . $fichier_msh . " \n"); print (" --> traitement du fichier $fichier_msh ---\n "); # on ouvre le fichier .her en écriture, on écrase donc le fichier existant my $fichier_her; if ($ARGV[1]) # si on a un argument 2, c'est le nom du fichier de sortie { $fichier_her = $ARGV[1];} else # sinon on construit le nom du fichier {$fichier_her = $nombase . '.her'; # on regarde s'il existe déjà foreach (<*.her>) { if ($_ eq $fichier_her) { print ("\n le fichier " . $fichier_her . " existe deja ! "); print ("\n voulez-vous l\' ecraser ? (0 ou N ) "); my $rep = ; chomp($rep); $rep=lc($rep); # lc passage en minuscule if ($rep eq 'n') {print ("\n nom du fichier de sortie ? "); $fichier_her = ; chomp($fichier_her); }; }; }; # fin du foreach }; # on supprime l'extension .her si elle existe $fichier_her =~ s/\.her//; # et on la rajoute $fichier_her .= '.her'; # maintenant on tente l'ouverture de fichier open (fic_her,">$fichier_her") || die (" \n erreur en ouverture du fichier " . $fichier_her . " \n"); #------------------------ fin des ouvertures de fichiers --------------------- #------------------ lecture des tag qui vont servir pour fabriquer les références ------------- print ("\n lecture des tags (preparation a la creation des references) "); # on lit dans les lignes jusqu'au mot clé $PhysicalNames my $ligne;my @champ; my $existe_physicalNames = 0; my $position_sur_node = 0; # pour signaler que l'on est à la position des noeuds # # debut des modifications - Stéphane # my $mesh_format; # ajout Stéphane while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $PhysicalNames if ( $champ[0] eq '$MeshFormat' ) # ajout Stéphane {$ligne = ; chomp($ligne); # sauvegarde de la ligne suivante # ajout Stéphane $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne # ajout Stéphane @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # ajout Stéphane $mesh_format = $champ[0]; # on recupere le format du maillage # ajout Stéphane print ("\n format de sauvegarde du maillage : msh " . $mesh_format . "\n" ); # ajout Stéphane } # ajout Stéphane if ( $champ[0] eq '$PhysicalNames' ) {$existe_physicalNames = 1;# on a trouvé le premier enreg, last; } elsif ( $champ[0] eq '$Nodes' ) {$existe_physicalNames = 0;# on a pas trouvé de $PhysicalNames print "\n **** NB: pas de chaine de caractere pour references a lire *****\n"; $position_sur_node = 1; # drapeau qui signale que l'on est au début des noeuds last; }; }; # --- on lit les tag si il en existe my %les_references = () ; # déclaration de la table des reference if ($existe_physicalNames) { $ligne = ; chomp($ligne); $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces print (" nombre total de references lus : " . $champ[0] ); my $nb_reference = $champ[0] ; # --- on lit chaque ligne de reference que l'on recopie dans un tableau jusqu'au mot clé $EndPhysicalNames while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $EndPhysicalNames if ( $champ[0] eq '$EndPhysicalNames' ) {last;}; # on a trouvé le mot cle de fin de reference, # ce n'est pas le mot clé, donc on enregistre la reference if ($mesh_format eq "2") # ajout Stéphane {$champ[1] =~ s/\"+//g; # on retire les guillemets éventuelles # ajout Stéphane $les_references{"$champ[0]"}= "$champ[1]"; # ajout Stéphane } # ajout Stéphane elsif ($mesh_format ge "2.1") # ajout Stéphane # modif version 1.8 {$champ[2] =~ s/\"+//g; # on retire les guillemets éventuelles # ajout Stéphane $les_references{"$champ[1]"}= "$champ[2]"; # ajout Stéphane }; # ajout Stéphane # # fin des modifications - Stéphane # }; print "\n les references "; while ( (my $cle, my $valeur) = each %les_references) { print "\n ".$cle . ' => ' .$valeur;}; }; #------------------ fin de la lecture des tag qui vont servir pour fabriquer les références ------------- # ++++++++++++++++++++++ lecture des coordonnées des noeuds ++++++++++++++++++++++++++ print ("\n lecture des coordonnees des noeuds "); # on lit dans les lignes jusqu'au mot clé $Nodes #MODIF J. Troufflard : ligne suivente en commentaire pour eviter warning ($ligne et @champ deja declares precedemment) ###############my $ligne;my @champ; if ($position_sur_node != 1) { while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $Nodes if ( $champ[0] eq '$Nodes' ) {$position_sur_node = 1; last;}; # on a trouvé le premier enreg, }; if ($position_sur_node != 1) { die ( "\n on n'a pas trouve le mot cle \$Nodes ?? , on ne peut pas continuer \n"); }; }; # --- on lit le nombre de noeud $ligne = ; chomp($ligne); $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces print (" nombre total de noeuds lus : " . $champ[0] ); my $nb_noeud = $champ[0] ; # --- on lit chaque ligne de coordonnée que l'on recopie dans un tableau jusqu'au mot clé $EndNodes my @les_noeuds = () ; # déclaration du tableau des coordonnées des noeuds while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $EndNodes if ( $champ[0] eq '$EndNodes' ) {last;}; # on a trouvé le premier enreg, # ce n'est pas le mot clé, donc on enregistre la ligne push @les_noeuds, $ligne; # sauvegarde des coordonnées et du numéro initial du noeud }; # ++++++++++++++++++++++ fin de lecture des coordonnees noeuds ++++++++++++++++++++++++++++++++++++ #-------- def de tableaux de conversion entre les numérotations gmsh et celles d'herezh++ ---------- # définition des types d'éléments my @type_element = ( 'rien pour le numero 0' , # '0' 'segment lineaire a 2 noeuds' , # '1' 'triangle lineaire a 3 noeuds' , # '2' 'quadrangle bilineaire a 4 noeuds' , # '3' 'tetrahedre lineaire a 4 noeuds' , # '4' 'hexahedre trilineaire a 8 noeuds' , # '5' 'pentaedre bilineaire a 6 noeuds' , # '6' 'pyramide a 5 noeuds' , # '7' 'segment quadratique a 3 noeuds' , # '8' 'triangle quadratique a 6 noeuds' , # '9' 'quadrangle quadratique complet a 9 noeuds' , #'10' 'tetraedre quadratique complet a 10 noeuds' , #'11' #MODIF J. Troufflard : ajout de "complet" 'hexaedre quadratique complet a 27 noeuds' , #'12' 'pentaedre quadratique complet a 18 noeuds' , #'13' 'pyramide quadratique a 14 noeuds' , #'14' ' point a 1 noeud ' , #'15' 'quadrangle quadratique incomplet a 8 noeuds' , #'16' 'hexaedre quadratique incomplet a 20 noeuds' , #'17' 'pentaedre quadratique incomplet a 15 noeuds' , #'18' 'pyramide quadratique incomplete a 13 noeuds' , #'19' '', #'20' #MODIF J. Troufflard : elements vides pour l instant '', #'21' # . '', #'22' # . '', #'23' # . '', #'24' '', #'25' '', #'26' '', #'27' '', #'28' '', #'29' '', #'30' '', #'31' '', #'32' '', #'33' '', #'34' '', #'35' 'quadrangle cubique complet a 16 noeuds' #'36' #MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE ); my @type_herezh_element = ( 'rien pour le numero 0', # '0' ' POUT BIE1 ' , # '1' ' TRIANGLE LINEAIRE ' , # '2' ' QUADRANGLE LINEAIRE ' , # '3' ' TETRAEDRE LINEAIRE ' , # '4' ' HEXAEDRE LINEAIRE ' , # '5' ' PENTAEDRE LINEAIRE ' , # '6' ' PYRAMIDE LINEAIRE ' , # '7' ' POUT BIE2 ' , # '8' ' TRIANGLE QUADRACOMPL ' , # '9' ' QUADRANGLE QUADRACOMPL ' , #'10' ' TETRAEDRE QUADRACOMPL ' , #'11' ' HEXAEDRE QUADRACOMPL ' , #'12' ' PENTAEDRE QUADRACOMPL ' , #'13' ' PYRAMIDE QUADRACOMPL ' , #'14' ' POINT LINEAIRE ' , #'15' ' QUADRANGLE QUADRATIQUE ' , #'16' ' HEXAEDRE QUADRATIQUE ' , #'17' ' PENTAEDRE QUADRATIQUE ' , #'18' ' PYRAMIDE QUADRATIQUE ' , #'19' '', #'20' #MODIF J. Troufflard : elements vides pour l instant '', #'21' # . '', #'22' # . '', #'23' # . '', #'24' '', #'25' '', #'26' '', #'27' '', #'28' '', #'29' '', #'30' '', #'31' '', #'32' '', #'33' '', #'34' '', #'35' ' QUADRANGLE CUBIQUE ' #'36' #MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE ); # les types et nombre de points d'intégration pour chaque éléments: # le premier chiffre indique le nombre de pti par défaut, si 0 : il n'y a pas plusieurs choix: un seul cas par défaut # puis les différents cas my @type_herezh_integration = ( [0], #'rien pour le numero 0', # '0' [0], # '1' POUT BIE1 [0], # '2' TRIANGLE LINEAIRE [0], # '3' QUADRANGLE LINEAIRE [0], # '4' TETRAEDRE LINEAIRE [8,1,27,64], # '5' HEXAEDRE LINEAIRE [2,1,6], # '6' PENTAEDRE LINEAIRE [0], # '7' PYRAMIDE LINEAIRE [0], # '8' POUT BIE2 -> QUADRATIQUE [0], # '9' TRIANGLE QUADRACOMPL [0], #'10' QUADRANGLE QUADRACOMPL [0], #'11' TETRAEDRE QUADRACOMPL [8,1,27,64], #'12' HEXAEDRE QUADRACOMPL [6,9,12,18], #'13' PENTAEDRE QUADRACOMPL [0], #'14' PYRAMIDE QUADRACOMPL [0], #'15' POINT LINEAIRE [0], #'16' QUADRANGLE QUADRATIQUE [8,1,27,64], #'17' HEXAEDRE QUADRATIQUE [6,9,12,18], #'18' PENTAEDRE QUADRATIQUE [0], #'19' PYRAMIDE QUADRATIQUE [], #'20' # MODIF J. Troufflard : elements vides pour l instant [], #'21' # . [], #'22' # . [], #'23' # . [], #'24' [], #'25' [], #'26' [], #'27' [], #'28' [], #'29' [], #'30' [], #'31' [], #'32' [], #'33' [], #'34' [], #'35' [0] #'36' QUADRANGLE CUBIQUE #MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE ); my @nbn_par_elem; $nbn_par_elem[0]=0; $nbn_par_elem[1]=2; $nbn_par_elem[2]=3; $nbn_par_elem[3]=4; $nbn_par_elem[4]=4; $nbn_par_elem[5]=8; $nbn_par_elem[6]=6; $nbn_par_elem[7]=5; $nbn_par_elem[8]=3; $nbn_par_elem[9]=6; $nbn_par_elem[10]=9; $nbn_par_elem[11]=10; $nbn_par_elem[12]=27; $nbn_par_elem[13]=18; $nbn_par_elem[14]=14; $nbn_par_elem[15]=1; $nbn_par_elem[16]=8; $nbn_par_elem[17]=20; $nbn_par_elem[18]=15; $nbn_par_elem[19]=13; $nbn_par_elem[36]=16;#MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE (16 noeuds) # $connex[i][j] donne pour l'element i, le num de gmsh pour le numéro j d'herezh my @connex = ( [], # le premier avec rien, pour que la numérotation commence à 1 [1,2], # 1: POUT BIE1 [1,2,3], # 2: TRIANGLE LINEAIRE [1,2,3,4], # 3: QUADRANGLE LINEAIRE [1,2,3,4], # 4: TETRAEDRE LINEAIRE [1,2,3,4,5,6,7,8], # 5: HEXAEDRE LINEAIRE [1,2,3,4,5,6], # 6: PENTAEDRE LINEAIRE [1,2,3,4,5], # 7: PYRAMIDE LINEAIRE [1,3,2], # 8: POUT BIE2 # pour QUADRATIQUE [1,2,3,4,5,6], # 9: TRIANGLE QUADRACOMPL [1,2,3,4,5,6,7,8,9], # 10: QUADRANGLE QUADRACOMPL [1,2,3,4,5,6,7,8,10,9], # 11: TETRAEDRE QUADRACOMPL [1,2,3,4,5,6,7,8,9,12,14,10,11,13,15,16,17,19,20,18,21,22,24,25,23,26,27], # 12: HEXAEDRE QUADRACOMPL # [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] uniquement pour voir les numéros [1,2,3,4,5,6,7,10,8,9, 11,12,13,15,14,16,18,17], # 13: PENTAEDRE QUADRACOMPL [1,2,3,4,5,6,7,8,9,10,11,12,13,14], # 14: PYRAMIDE QUADRACOMPL [1], # 15: POINT LINEAIRE [1,2,3,4,5,6,7,8], # 16: QUADRANGLE QUADRATIQUE [1,2,3,4,5,6,7,8,9,12,14,10,11,13,15,16,17,19,20,18], # 17: HEXAEDRE QUADRATIQUE # [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20], # 17: HEXAEDRE QUADRATIQUE [1,2,3,4,5,6,7,10,8,9, 11,12,13,15,14], # 18: PENTAEDRE QUADRATIQUE [1,2,3,4,5,6,7,8,9,10,11,12,13], # 19: PYRAMIDE QUADRATIQUE [], #20 [], #21 [], #22 [], #23 [], #24 [], #25 [], #26 [], #27 [], #28 [], #29 [], #30 [], #31 [], #32 [], #33 [], #34 [], #35 [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], # 36: #MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE ); my @type_geom = ( 'RIEN_TYPE_GEOM', # '0' 'LIGNE' , # '1' 'SURFACE' , # '2' 'SURFACE' , # '3' 'VOLUME' , # '4' 'VOLUME' , # '5' 'VOLUME' , # '6' 'VOLUME' , # '7' 'LIGNE' , # '8' 'SURFACE' , # '9' 'SURFACE' , #'10' 'VOLUME' , #'11' 'VOLUME' , #'12' 'VOLUME' , #'13' 'VOLUME' , #'14' 'POINT_G' , #'15' 'SURFACE' , #'16' 'VOLUME' , #'17' 'VOLUME' , #'18' 'VOLUME' , #'19' '', #'20' '', #'21' '', #'22' '', #'23' '', #'24' '', #'25' '', #'26' '', #'27' '', #'28' '', #'29' '', #'30' '', #'31' '', #'32' '', #'33' '', #'34' '', #'35' 'SURFACE', #36 #MODIF J. Troufflard : ajout de QUADRANGLE CUBIQUE ); #-------- fin def de tableaux de conversion entre les numérotations gmsh et celles d'herezh++ ---------- # ++++++++++++++++++++++ lecture des éléments +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ print ("\n lecture des elements "); while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $Elements if ( $champ[0] eq '$Elements' ) {last;}; # on a trouvé le premier enreg, }; # ----- on lit le nombre d'éléments $ligne = ; chomp($ligne); $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces print (" nombre total d'elements lus : " . $champ[0] ); my $nb_element = $champ[0] ; # --- on lit chaque ligne que l'on recopie dans des tableaux jusqu'au mot clé $EndElements my @liste_element = (); # ce sera un tableau multidimentionel # chaque élément de @liste_element est une liste d'éléments d'un m^eme type # $liste_element[i] = la liste des éléments de type i # $liste_element[i][j] un élément = une liste d'entiers donc un tableau # $liste_element [i][j][k] = un scalaire (entier) ouf !! my @number_type = (); # les nombres d'élément de chaque type while () { $ligne = $_; chomp($ligne); # sauvegarde de la ligne $ligne =~ s/^[ \t]+//mg; # suppression des blancs et tabulation en début de ligne @champ = split (/\s+/,$ligne); # le /s+/ permet de séparer sur des espaces # on lit dans le fichier jusqu'au mot clé $EndElements if ( $champ[0] eq '$EndElements' ) {last;}; # on a trouvé le premier enreg, # traitement et enregistrement push @{$liste_element[$champ[1]]}, [@champ ]; # tableau multidimentionnel, syntaxe particulière #if ( $champ[1] == 15) # {print "\n trouve " . @champ; print " ligne = " . $ligne; # print ",,, " .$champ[0]." ".$champ[1]." ".$champ[2]." ".$champ[3]." ".$champ[4]." ".$champ[5]." ";}; $number_type[$champ[1]]++; }; # test débug #print "\n essai= " . $liste_element[15][1][3] ; #print "\n une tranche # on recherche le nombre d'élément différent my $nb_type_elem = 0; my $taille_list_elem = $#liste_element; #print "\n number_type = " . @number_type; for (my $j=1;$j<=$taille_list_elem;$j++) { #MODIF J. Troufflard : ajout conditionnelle "defined" pour eviter warning en cas de $number_type[$j] # non renseigne pour certaines valeurs de $j (Use of uninitialized value etc...) if (defined $number_type[$j] and $number_type[$j] != 0) { print "\n nombre d'elements du type ".$type_element[$j] ." = " . $number_type[$j] ; $nb_type_elem++; }; }; print "\n nombre initial d'elements differents " . $nb_type_elem ; # maintenant on demande si l'on veut tous les éléments ou certain uniquement my @number_type_initial = @number_type; # sauvegarde pour le traitement des références print "\n\n === choix d'elements: voulez-vous ? "; for (my $j=1;$j<=$taille_list_elem;$j++) { #MODIF J. Troufflard : ajout conditionnelle "defined" pour eviter warning en cas de $number_type[$j] # non renseigne pour certaines valeurs de $j (Use of uninitialized value etc...) if (defined $number_type[$j] and $number_type[$j] != 0) { print "\n conserver les elements du type ".$type_element[$j] ." (rep o ou n) " ; my $rep = ; chomp($rep); $rep=lc($rep); # lc passage en minuscule if ($rep eq 'o') {print (' ===> ok, on conserve les elements '.$type_element[$j] . "\n");} else {print (' *** on supprime les elements '.$type_element[$j] .'*** '. "\n"); $number_type[$j] = 0; } }; }; # on demande éventuellement le nombre de point d'intégration my @type_out_integration; # le tableau contenant les types d'integration for (my $j=1;$j<=$taille_list_elem;$j++) { if ($number_type[$j] != 0) # on ne traite que les éléments que l'on a gardé {if ($type_herezh_integration[$j] == 0) {$type_out_integration[$j] = ' '; }#push @type_out_integration, ' ';} # rien pour la sortie else { # cas où plusieurs type de point d'intégration sont possible print ($type_element[$j].": nombre de points d'integration par defaut ".$type_herezh_integration[$j][0]." ? (rep o/n) "); my $rep = ; chomp($rep); $rep=lc($rep); # lc passage en minuscule if ($rep eq 'o') {$type_out_integration[$j] = ' '; } else # cas où plusieurs choix existent { print (" valeur preconisee parmi: "); foreach my $nbpti ( @{$type_herezh_integration[$j]}) { print ( $nbpti . " ");}; print (" : ? "); my $rep = ; chomp($rep); if ($rep != $type_herezh_integration[$j][0]) {$type_out_integration[$j] = ' _cm'.$rep.'pti ';} else {$type_out_integration[$j] = ' '; }; }; print ("\n"); } }; }; # ++++++++++++++++++++++ fin lecture des éléments ++++++++++++++++++++++++++ # ++++++++++++++++++++++ création des références ++++++++++++++++++++++++++++++ # les références de noeuds se trouvent par l'intermédiaire des éléments "points" # on passe donc en revue ces éléments my %ref_noeud; # def de conteneur des références de noeuds my %ref_element; # def du conteneur des références d'éléments my %ref_arete; # def du conteneur des références d'arretes my %ref_surface; # def du conteneur des références de surfaces #print "\n taille de la liste d'elem = " . $taille_list_elem; my $numero = 1; for (my $j=1;$j<=$taille_list_elem;$j++) { #print "\n taille des elem = " . $number_type[$j] ; # !!! la sélection est maintenant faite à l'intérieur de la boucle # c'est moins performant mais cela permet d'avoir des ref de points de ligne, surface, volume # m^eme si ces derniers ne sont pas sélectionné comme éléments à retenir !! # if (($number_type[$j] != 0) || ($liste_element[$j][0][1] == 15)) { my $nb_el = $number_type_initial[$j]; #print "\n nb_el= ".$nb_el; for (my $el = 0;$el < $nb_el;$el++) { # ------- cas des références de noeuds ----- if ($liste_element[$j][$el][1] == 15) # 15 c'est le type point { # on balaie les tag pour ajouter my $nbtag = $liste_element[$j][$el][2]; # récup du nombre de tag # on différencie les deux derniers tags qui sont : # 1) le numéro de l'entité géométrique élémentaires # 2) le numéro de la partition de maillage # en fait pour les points il semble qu'il n'y ait que un tag sup, donc on va jusqu'à $nbtag-1 # --- tout d'abord les tag des noms physiques (ceux qui ne sont pas généré automatiquement) for (my $ic = 0; $ic < $nbtag-1; $ic++) { my $indic_ref = $liste_element[$j][$el][3+$ic]; # l'indicateur de la référence #print "\n indicateur de la reference : ".$indic_ref; my $nbnoe = $liste_element[$j][$el][3+ $nbtag]; # le numéro du noeud # $les_references{"$indic_ref"} = le nom de la référence, si ce n'est pas directement le nombre my $nom = $les_references{"$indic_ref"}; #print "\n l equivalent d'indicateur de ref ".$nom; if ($nom ne undef) { # cas ou le nom de la référence existe if ( $ref_noeud{'N_' . $nom} == undef) # si la référence n'est pas définie on la définie { my @tab = ($nbnoe); #print "\n la cle = " . 'N_' . $nom; $ref_noeud{'N_' . $nom} = [@tab]; # on sauvegarde le tableau } else { #print "\n la cle = " . 'N_' . $nom; push @{$ref_noeud{'N_' . $nom}}, $nbnoe; }; } else { # cas ou le nom de la référence n'existe pas, on utilise directement le nombre if ( $ref_noeud{'N_' ."$indic_ref"} == undef) # si la référence n'est pas définie on la définie { my @tab = ($nbnoe); $ref_noeud{'N_' ."$indic_ref"} = [@tab]; # on sauvegarde le tableau } else { push @{$ref_noeud{'N_' ."$indic_ref"}}, $nbnoe; }; }; }; # --- puis les 2 tags automatique: # 1) le numéro de l'entité géométrique élémentaires # 2) le numéro de la partition de maillage # en fait pour les points il semble qu'il n'y ait que un tag sup, donc on va jusqu'à $nbtag-1 my $geoParti = 1; # pour choisir entre les deux for (my $ic = $nbtag-1 ; $ic < $nbtag; $ic++,$geoParti++) { my $indic_ref = $liste_element[$j][$el][3+$ic]; # l'indicateur de la référence #print "\n indicateur de la reference : ".$indic_ref; my $nbnoe = $liste_element[$j][$el][3+ $nbtag]; # le numéro du noeud # ici il s'agit exclusiment de nombre, on l'utilise directement # on signale la différence avec $geoParti if ( $ref_noeud{'N_'."$geoParti".'_'."$indic_ref"} == undef) # si la référence n'est pas définie on la définie { my @tab = ($nbnoe); $ref_noeud{'N_'."$geoParti".'_'."$indic_ref"} = [@tab]; # on sauvegarde le tableau } else { push @{$ref_noeud{'N_'."$geoParti".'_'."$indic_ref"}}, $nbnoe; }; }; } else # diff de 15 donc éléments normal # ------- cas des références d'éléments ----- # on va également créer des références de noeuds correspondants à chaques références particulières # d'éléments ce qui permettra d'avoir des ref des noeuds de lignes, de surfaces ou de volumes particulières { # on balaie les tag pour ajouter my $tyyp = $liste_element[$j][$el][1]; # le type de l'élément my $nbtag = $liste_element[$j][$el][2]; # récup du nombre de tag # on différencie les deux derniers tags qui sont : # 1) le numéro de l'entité géométrique élémentaires # 2) le numéro de la partition de maillage # --- tout d'abord les tag des noms physiques (ceux qui ne sont pas généré automatiquement) my %tag_deja_traite; my $fin_tag = $nbtag-2;# ajout Stéphane version 1.8 if ($mesh_format ge "2.2") {$fin_tag++;};# ajout Stéphane version 1.8 for (my $ic = 0; $ic < $fin_tag; $ic++) # ajout Stéphane version 1.8 # for (my $ic = 0; $ic < $nbtag-2; $ic++) # modif Stéphane version 1.8 { my $indic_ref = $liste_element[$j][$el][3+$ic]; # l'indicateur de la référence # dans le cas où il y a un nom de référence, l'indicateur de référence est doublé # ce qui n'est pas normal, on supprime ce doublement if ($tag_deja_traite{"$indic_ref"} ne undef) {next;} $tag_deja_traite{"$indic_ref"} = '1'; # de maniere à pas avoir de undef #print "\n indicateur de la reference : ".$indic_ref; # $les_references{"$indic_ref"} = le nom de la référence, si ce n'est pas directement le nombre my $nom = $les_references{"$indic_ref"}; #print "\n l equivalent d'indicateur de ref ".$nom; if ($nom ne undef) { # cas ou le nom de la référence d'élément existe (on applique les m^eme règles pour les N associés) if ( $ref_element{'E_' . $nom} == undef) # si la référence n'est pas définie on la définie { #print "\n la cle = " . 'E_' . $nom; # on n'intervient pour les ref d'éléments que si ces éléments sont à retenir if ($number_type[$j] != 0) { my @tab = ($numero); $ref_element{'E_' . $nom} = [@tab]; # on sauvegarde le tableau # idem pour la ref de surfaces associés, mais ici dans le cas ou c'est un élément de surface #print "\n le type de geom = " . 'E_' . $nom; if ($type_geom[$tyyp] eq "SURFACE") { my @tab_S = ($numero); $ref_surface{'F_' . $nom} = [@tab_S]; # on sauvegarde le tableau }; # idem pour la ref d'arete associés, mais ici dans le cas ou c'est un élément linéique if ($type_geom[$tyyp] eq "LIGNE") { my @tab_L = ($numero); $ref_arete{'A_' . $nom} = [@tab_L]; # on sauvegarde le tableau }; }; } else { #print "\n la cle = " . 'E_' . $nom; # on n'intervient pour les ref d'éléments que si ces éléments sont à retenir if ($number_type[$j] != 0) { push @{$ref_element{'E_' . $nom}}, $numero; # idem pour la ref de surfaces associés, mais ici dans le cas ou c'est un élément de surface if ($type_geom[$tyyp] eq "SURFACE") { push @{$ref_surface{'F_' . $nom}}, $numero;}; # idem pour la ref d'arete associés, mais ici dans le cas ou c'est un élément linéique if ($type_geom[$tyyp] eq "LIGNE") { push @{$ref_arete{'A_' . $nom}}, $numero;}; }; }; # idem pour la ref de noeuds associés, mais ici dans tous les cas if ( $ref_noeud{'N_'."$type_geom[$tyyp]".'_'.$nom} == undef) { my @t_noeud_ref_elem; # on sauvegarde le tableau (mais ici pour l'instant sans rien dedans) $ref_noeud{'N_'."$type_geom[$tyyp]".'_'.$nom} = [@t_noeud_ref_elem]; }; # on rempli le tableau de num de noeud pour la ref de noeuds associé for (my $ia =0;$ia < $nbn_par_elem[$tyyp]; $ia++) { my $bb = $liste_element[$j][$el][3+ $nbtag + $ia ]; # le numero de noeud push @{$ref_noeud{'N_'."$type_geom[$tyyp]".'_'.$nom}}, $bb; }; } else { # cas ou le nom de la référence n'existe pas, on utilise directement le nombre if ( $ref_element{'E_' ."$indic_ref"} == undef) # si la référence n'est pas définie on la définie { # on n'intervient pour les ref d'éléments que si ces éléments sont à retenir if ($number_type[$j] != 0) { my @tab = ($numero); $ref_element{'E_' ."$indic_ref"} = [@tab]; # on sauvegarde le tableau # idem pour la ref de surfaces associés, mais ici dans le cas ou c'est un élément de surface if ($type_geom[$tyyp] eq "SURFACE") { my @tab_S = ($numero); $ref_surface{'F_' ."$indic_ref"} = [@tab_S]; # on sauvegarde le tableau }; # idem pour la ref d'arete associés, mais ici dans le cas ou c'est un élément linéique if ($type_geom[$tyyp] eq "LIGNE") { my @tab_L = ($numero); $ref_arete{'A_' . "$indic_ref"} = [@tab_L]; # on sauvegarde le tableau }; }; } else { # on n'intervient pour les ref d'éléments que si ces éléments sont à retenir if ($number_type[$j] != 0) { push @{$ref_element{'E_' ."$indic_ref"}}, $numero; # idem pour la ref de surfaces associés, mais ici dans le cas ou c'est un élément de surface if ($type_geom[$tyyp] eq "SURFACE") { push @{$ref_surface{'F_' . "$indic_ref"}}, $numero;}; # idem pour la ref d'arete associés, mais ici dans le cas ou c'est un élément linéique if ($type_geom[$tyyp] eq "LIGNE") { push @{$ref_arete{'A_' . "$indic_ref"}}, $numero;}; }; }; # idem pour la ref de noeuds associés, mais ici dans tous les cas if ( $ref_noeud{'N_'."$type_geom[$tyyp]".'_'."$indic_ref"} == undef) { my @t_noeud_ref_elem; # on sauvegarde le tableau (mais ici pour l'instant sans rien dedans) $ref_noeud{'N_'."$type_geom[$tyyp]".'_'."$indic_ref"} = [@t_noeud_ref_elem]; }; # on rempli le tableau de num de noeud pour la ref de noeuds associé for (my $ia =0;$ia < $nbn_par_elem[$tyyp]; $ia++) { my $bb = $liste_element[$j][$el][3+ $nbtag + $ia ]; # le numero de noeud push @{$ref_noeud{'N_'."$type_geom[$tyyp]".'_'."$indic_ref"}}, $bb; }; }; }; # --- puis les 2 tags automatique: # 1) le numéro de l'entité géométrique élémentaires # 2) le numéro de la partition de maillage # on n'intervient pour les ref d'éléments que si ces éléments sont à retenir if ($number_type[$j] != 0) { my $geoParti = 1; # pour choisir entre les deux for (my $ic = $nbtag-2 ; $ic < $nbtag; $ic++,$geoParti++) { my $indic_ref = $liste_element[$j][$el][3+$ic]; # l'indicateur de la référence # dans le cas où il y a un nom de référence, l'indicateur de référence est doublé # ce qui n'est pas normal, on supprime ce doublement if ($tag_deja_traite{"$indic_ref"} ne undef) {next;} $tag_deja_traite{"$indic_ref"} = '1'; # de maniere à pas avoir de undef { # cas ou le nom de la référence n'existe pas, on utilise directement le nombre if ( $ref_element{'E_'."$geoParti".'_'."$indic_ref"} == undef) # si la référence n'est pas définie on la définie { my @tab = ($numero); $ref_element{'E_'."$geoParti".'_'."$indic_ref"} = [@tab]; # on sauvegarde le tableau } else { push @{$ref_element{'E_'."$geoParti".'_'."$indic_ref"}}, $numero; }; }; }; }; }; # on suit le cas de l'écriture finale des éléments donc on n'incrémente le numéro # d'élément que s'il sera écrit if ($number_type[$j] != 0) { $numero++;}; }; }; }; # --- maintenant, pour les références de noeuds on va supprimer les doublons, car le mode # de construction des références d'éléments entra^ine systématiquement des doublons foreach my $refno(keys %ref_noeud) { # on crée une table de hachage de num de noeuds my %les_noeuds; # on parcours les numéros que l'on stocke dans la table (mais ici le mode de stockage # conduit à pas de doublon foreach my $nbnoeu ( @{$ref_noeud{$refno}}) { $les_noeuds{$nbnoeu} = $nbnoeu;}; # maintenant on crée un tableau intermédiaire qui va contenir les noeuds définitif my @noeuds_def; foreach my $cle (sort keys %les_noeuds) { push @noeuds_def,$les_noeuds{$cle}; }; # enfin on remplace le tableau associé à la référence de noeud par celui que l'on vient de créer $ref_noeud{$refno} = [@noeuds_def]; }; # ++++++++++++++++++++++ fin création des références ++++++++++++++++++++++++++ print ("\n "); close (fic_msh); #====================== écriture du fichier .her ============================ #------------------- écriture de l'entete du fichier .her --------------------- print fic_her ("\n"); print fic_her $EN_TETE_MSH2ER; print fic_her ("\n\n\n"); my $nom_maillage = $fichier_her; $nom_maillage =~ s/\.her//; print fic_her ("\n nom_maillage ".$nom_maillage ."\n\n"); #------------------- écriture des noeuds --------------------- # ------ entete des noeuds -------- print fic_her ("\n" . ' noeuds ------------'); print fic_her ("\n $nb_noeud NOEUDS "); # ici écriture du nombre de noeuds print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' #|NO DU| X | Y | Z |'); print fic_her ("\n" . ' #|NOEUD| | | |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n"); # ------ la liste des coordonnées des noeuds -------- for (my $k=0; $k < $nb_noeud; $k++) { my $enreg = $les_noeuds[$k]; @champ = split (/\s+/,$enreg); # le /s+/ permet de séparer sur des espaces # print fic_her ("\n ". ($k+1) ." ". $champ[1] ." ". $champ[2] ." ". $champ[3] ); print fic_her ("\n ". $champ[0] ." ". $champ[1] ." ". $champ[2] ." ". $champ[3] ); }; print fic_her ("\n\n\n"); # ------ liste de références de noeuds ----------- print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' # references de noeuds |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n"); foreach my $refno (keys %ref_noeud) { #MODIF J. Troufflard : option -nom_ref_strict # => suppression des eventuels ajouts de "_LIGNE", "_SURFACE", "_VOLUME" dans # les noms de liste de reference my $nom_ref_a_ecrire = $refno; if($is_opt_nom_ref_strict) { $nom_ref_a_ecrire =~ s/_LIGNE//; $nom_ref_a_ecrire =~ s/_SURFACE//; $nom_ref_a_ecrire =~ s/_VOLUME//; } #MODIF J. Troufflard : option -only_ref => on ne garde que les refs contenues dans la liste @liste_only_ref next if($is_opt_only_ref and not " @liste_only_ref " =~ / $nom_ref_a_ecrire /); print fic_her ( "\n ".$nom_ref_a_ecrire . " "); # le nom de la référence my $compteur = 1; foreach my $nbnoeu ( @{$ref_noeud{$refno}}) { print fic_her ( $nbnoeu . " "); $compteur++; if ($compteur > 20) { print fic_her ("\n "); $compteur = 1; }; }; print fic_her ("\n "); }; #------------------- fin écriture des noeuds --------------------- #-------------------- écriture des éléments -------------------- print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' # les elements |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); # ------ entete des éléments -------- # on compte les éléments à sortir my $nb_elementASortir = 0; for (my $j=1;$j<=$taille_list_elem;$j++) { if ($number_type[$j] != 0) { $nb_elementASortir += $number_type[$j];}; }; print fic_her ("\n" . ' elements ------------'); print fic_her ("\n $nb_elementASortir ELEMENTS "); # ici écriture du nombre de noeuds print fic_her ("\n\n\n"); print fic_her ("\n" . ' #----------------------------------------------------------------------'); print fic_her ("\n" . ' #| NO | | |'); print fic_her ("\n" . ' #|ELTS | type element | Noeuds |'); print fic_her ("\n" . ' #----------------------------------------------------------------------'); print fic_her ("\n"); # ------ écriture des éléments ------ $numero = 1; for (my $j=1;$j<=$taille_list_elem;$j++) { if ($number_type[$j] != 0) { my $nb_el = $number_type[$j]; for (my $el = 0;$el < $nb_el;$el++) { my $nbtag = $liste_element[$j][$el][2]; # écriture du numéro de l'élément puis du descriptif print fic_her ("\n ". $numero ." ". $type_herezh_element[$j] .$type_out_integration[$j]." "); my $tyyp = $liste_element[$j][$el][1]; # le type de l'élément #print " tyyp= ".$tyyp."\n"; for (my $ia =0;$ia < $nbn_par_elem[$j]; $ia++) { # $ia = numéro d'ordre du noeud au format gmsh # $connex[$tyyp][$ia] = numéro d'ordre du noeud au format herezh++ #print " ia= " . $ia ." connex= " . $connex[$tyyp][$ia]." "; my $bb = $liste_element[$j][$el][2+ $nbtag + $connex[$tyyp][$ia] ]; # le numero herezh print fic_her ( $bb . " "); }; $numero++; } }; }; # ------- écriture des références d'éléments --------- print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' # references elements |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n"); foreach my $refel (keys %ref_element) { #MODIF J. Troufflard : option -nom_ref_strict # => suppression des eventuels ajouts de "_LIGNE", "_SURFACE", "_VOLUME" dans # les noms de liste de reference my $nom_ref_a_ecrire = $refel; if($is_opt_nom_ref_strict) { $nom_ref_a_ecrire =~ s/_LIGNE//; $nom_ref_a_ecrire =~ s/_SURFACE//; $nom_ref_a_ecrire =~ s/_VOLUME//; } #MODIF J. Troufflard : option -only_ref => on ne garde que les refs contenues dans la liste @liste_only_ref next if($is_opt_only_ref and not " @liste_only_ref " =~ / $nom_ref_a_ecrire /); print fic_her ( "\n ".$nom_ref_a_ecrire . " "); # le nom de la référence my $compteur = 1; foreach my $nbnelem ( @{$ref_element{$refel}}) { print fic_her ( $nbnelem . " "); $compteur++; if ($compteur > 24) { print fic_her ("\n "); $compteur = 1; }; }; print fic_her ("\n "); }; # ------- écriture des références d'arete d'éléments --------- print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' # references aretes elements |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n"); foreach my $refel (keys %ref_arete) { #MODIF J. Troufflard : option -nom_ref_strict # => suppression des eventuels ajouts de "_LIGNE", "_SURFACE", "_VOLUME" dans # les noms de liste de reference my $nom_ref_a_ecrire = $refel; if($is_opt_nom_ref_strict) { $nom_ref_a_ecrire =~ s/_LIGNE//; $nom_ref_a_ecrire =~ s/_SURFACE//; $nom_ref_a_ecrire =~ s/_VOLUME//; } #MODIF J. Troufflard : option -only_ref => on ne garde que les refs contenues dans la liste @liste_only_ref next if($is_opt_only_ref and not " @liste_only_ref " =~ / $nom_ref_a_ecrire /); print fic_her ( "\n ".$nom_ref_a_ecrire . " "); # le nom de la référence my $compteur = 1; foreach my $nbnelem ( @{$ref_arete{$refel}}) { print fic_her ( $nbnelem . " 1 "); $compteur++; if ($compteur > 15) { print fic_her ("\n "); $compteur = 1; }; }; print fic_her ("\n "); }; # ------- écriture des références de faces d'éléments --------- print fic_her ("\n\n\n"); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n" . ' # references de faces elements |'); print fic_her ("\n" . ' #---------------------------------------------------------------'); print fic_her ("\n"); foreach my $refel (keys %ref_surface) { #MODIF J. Troufflard : option -nom_ref_strict # => suppression des eventuels ajouts de "_LIGNE", "_SURFACE", "_VOLUME" dans # les noms de liste de reference my $nom_ref_a_ecrire = $refel; if($is_opt_nom_ref_strict) { $nom_ref_a_ecrire =~ s/_LIGNE//; $nom_ref_a_ecrire =~ s/_SURFACE//; $nom_ref_a_ecrire =~ s/_VOLUME//; } #MODIF J. Troufflard : option -only_ref => on ne garde que les refs contenues dans la liste @liste_only_ref next if($is_opt_only_ref and not " @liste_only_ref " =~ / $nom_ref_a_ecrire /); print fic_her ( "\n ".$nom_ref_a_ecrire . " "); # le nom de la référence my $compteur = 1; foreach my $nbnelem ( @{$ref_surface{$refel}}) { print fic_her ( $nbnelem . " 1 "); $compteur++; if ($compteur > 15) { print fic_her ("\n "); $compteur = 1; }; }; print fic_her ("\n "); }; #------------------- fin écriture des éléments --------------------- print fic_her ("\n\n\n"); close (fic_her); # fermeture du fichier de maillage .her #MODIF J. Troufflard : lecture du maillage dans des variables pour effectuer diverses operations par la suite my ($nb_noeuds, $ref_noeuds, $nb_elts, $ref_elements, @ref_listes); ($nom_maillage, $nb_noeuds, $ref_noeuds, $nb_elts, $ref_elements, @ref_listes) = lecture_mail_her($fichier_her); #MODIF J. Troufflard : suppression des noeuds non references # cette operation supprime les noeuds qui n appartiennent a aucun element # et actualise en consequence les listes de references (reecriture complete du fichier .her) suppr_noeuds_non_references($fichier_her, $nom_maillage, $nb_noeuds, $ref_noeuds, $nb_elts, $ref_elements, \@ref_listes); #MODIF J. Troufflard : en cas d option -only_ref, on regarde si des listes demandees n ont pas ete trouvees # en cas d absence de listes, on le signale dans le terminal if($is_opt_only_ref) { #recuperation de tous les noms de liste de reference du maillage actuel (dans une chaine de caracteres) my $listes_ref = ""; #-- noeuds foreach my $nom (keys(%{$ref_listes[0]})) { $listes_ref .= " $nom"; } #-- aretes foreach my $nom (keys(%{$ref_listes[1]})) { $listes_ref .= " $nom"; } #-- faces foreach my $nom (keys(%{$ref_listes[2]})) { $listes_ref .= " $nom"; } #-- elements foreach my $nom (keys(%{$ref_listes[3]})) { $listes_ref .= " $nom"; } $listes_ref .= " "; #verif des listes -only_ref my @listes_manquantes; foreach my $nom (@liste_only_ref) { next if($listes_ref =~ / $nom /); push(@listes_manquantes, $nom); } #si des listes manquent, on les affiche if($#listes_manquantes != -1) { print "\n"; print "**option -only_ref :\n"; print " les listes suivantes, requises par -only_ref, n ont pas ete trouvees :\n"; print " > $_\n" for @listes_manquantes; print "\n"; } } #MODIF J. Troufflard : application de l option -axi => transformer les elements POUT, TRIANGLE et QUADRANGLE en SEG_AXI, TRIA_AXI et QUAD_AXI if($is_opt_axi) { print "\n"; print "**option -axi : transformation des elements POUT, TRIANGLE et QUADRANGLE en elements axisymetriques...\n"; print "\n"; open(FIC, "<$fichier_her"); open(FIC2, ">$fichier_her.abcdefgh$$.her"); while() { s/^(\s*\d+\s+)POUT(\s+)/$1SEG_AXI$2/; s/^(\s*\d+\s+)TRIANGLE(\s+)/$1TRIA_AXI$2/; s/^(\s*\d+\s+)QUADRANGLE(\s+)/$1QUAD_AXI$2/; print FIC2; } close(FIC); close(FIC2); system("mv -f $fichier_her.abcdefgh$$.her $fichier_her"); }#if($is_opt_axi) print ("\n" . '#############################################################################'); print ("\n" . '#msh2her.pl #'); print ("\n" . '# fin creation du fichier de maillage .her #'); print ("\n" . '#############################################################################'."\n\n"); #MODIF J. Troufflard #---------------- #sub qui gere la suppression des noeuds non references # en entree : nom du fichier .her contenant le maillage # # fonctionnement : # on part du maillage qui est ecrit une premiere fois par msh2her.pl avant l appel a cette sub # # etape 1) recuperation du maillage en entree via les variables fournies par la sub lecture_mail_her() (nom maillage, noeuds, etc...) # etape 2) modification des variables (noeuds, elements, liste de ref) en fonction de la suppression des # eventuels noeuds non references # etape 3) reecriture du fichier maillage # le maillage est reecrit en conservant le style du fichier produit auparavant # # **** A FAIRE DANS UNE PROCHAINE VERSION (a propos etape 3) ) *** # le choix de reprendre le style est fait pour garder une coherence avec les fichiers .her produits par # les versions anterieures de msh2her.pl. # ca fait un peu doublon en terme de code. Il faudrait ecrire une sub # qui centralise l operation d ecriture du maillage. Elle serait appelee une fois apres la lecture du .msh # et une seconde fois dans la sub suppr_noeuds_non_references() # **Probleme a gerer : actuellement la structure des variables est tres differente # entre celles utilises lors la lecture du .msh (@les_noeuds, @type_herezh_element, etc...) # et celles fournies en sortie de la sub lecture_mail_her() # sub suppr_noeuds_non_references { my $fher = shift; my $nom_maillage = shift; my $nb_noeuds = shift; my $ref_noeuds = shift; my $nb_elts = shift; my $ref_elements = shift; my $tmp_ref_listes = shift; my @ref_listes = @$tmp_ref_listes;#on remet le dernier argument sous forme de liste #liste des noeuds n appartenant a aucun element (noeuds non references) my @ind_noeuds; for(my $i=1; $i<=$nb_noeuds; $i++) {$ind_noeuds[$i] = 0;} for(my $i=1; $i<=$nb_elts; $i++) {foreach my $noeud (@{$ref_elements->{$i}{'CONNEX'}}) {$ind_noeuds[$noeud] = 1;}} my @noeuds_non_ref; for(my $i=1; $i<=$nb_noeuds; $i++) {push(@noeuds_non_ref,$i) if($ind_noeuds[$i] == 0);} #suppression des noeuds non references et modif dans les listes de noeuds for(my $i=1; $i<=$nb_noeuds; $i++) { undef(@{$ref_noeuds->[$i]}) if(not $ind_noeuds[$i]); } #creation de la nouvelle table des noeuds my @tab_noeuds_final; my $nb_noeuds_final = 0; my @tab_corresp_ini_final; for(my $i=1; $i<=$nb_noeuds; $i++) { $tab_corresp_ini_final[$i] = 0; next if(not defined($ref_noeuds->[$i][0])); $nb_noeuds_final++; @{$tab_noeuds_final[$nb_noeuds_final]} = @{$ref_noeuds->[$i]}; $tab_corresp_ini_final[$i] = $nb_noeuds_final; } #modif de la table des elements for(my $i=1; $i<=$nb_elts; $i++) { for(my $j=0; $j<=$#{$ref_elements->{$i}{'CONNEX'}}; $j++) { $ref_elements->{$i}{'CONNEX'}[$j] = $tab_corresp_ini_final[$ref_elements->{$i}{'CONNEX'}[$j]]; } } #modif des listes de noeuds my $noeud_old; my @new_liste; foreach my $nom_liste (keys(%{$ref_listes[0]})) { undef(@new_liste); for(my $i=0; $i<=$#{$ref_listes[0]->{$nom_liste}}; $i++) { $noeud_old = $ref_listes[0]->{$nom_liste}[$i]; push(@new_liste,$tab_corresp_ini_final[$noeud_old]) if(defined($ref_noeuds->[$noeud_old][0])); } #si nouvelle liste non vide, on remplace if(defined($new_liste[0])) { @{$ref_listes[0]->{$nom_liste}} = @new_liste; } #sinon, on supprime la key de la table avec delete() else {delete($ref_listes[0]->{$nom_liste});} }#foreach my $nom_liste (keys(%{$ref_listes[0]})) #saisie de l ordre des listes de references dans le fichier (pour les recopier dans le meme ordre que le fichier original) # (on les classe par "level", c est-a-dire : "NOEUDS" => apres les noeuds dans le .her # "ELEMENTS" => apres les elements dans le .her my %ordre_listes; my $level; open(Fher, "<$fher"); while() { if(/^\s*noeuds/) {$level = "NOEUDS";} elsif(/^\s*elements/) {$level = "ELEMENTS";} elsif(/^\s*(N\S+)/) {push(@{$ordre_listes{$level}},$1);} elsif(/^\s*(A\S+)/) {push(@{$ordre_listes{$level}},$1);} elsif(/^\s*(F\S+)/) {push(@{$ordre_listes{$level}},$1);} elsif(/^\s*(E\S+)/) {push(@{$ordre_listes{$level}},$1);} elsif(/^\s*(G\S+)/) {push(@{$ordre_listes{$level}},$1);} } close(Fher); #reecriture du maillage (en reprenant la presentation du fichier open(Fher, ">$fher"); print Fher ("\n"); print Fher ("\n" . '#############################################################################'); print Fher ("\n" . '# #'); print Fher ("\n" . '# msh2her.pl #'); print Fher ("\n" . '# transformation d\'un maillage genere par le programme gmsh #'); print Fher ("\n" . '# en un maillage utilisable par Herezh++ #'); print Fher ("\n" . '#############################################################################'); print Fher ("\n" . '# licence GPL, gerard.rio@univ-ubs.fr #'); print Fher ("\n" . '# http://www-lg2m.univ-ubs.fr/~rio #'); print Fher ("\n" . '# version '."$version".' #'); print Fher ("\n" . '#############################################################################'); print Fher ("\n\n\n"); #nom du maillage (eventuel) print Fher "\n nom_maillage $nom_maillage\n\n" if(defined($nom_maillage)); #noeuds print Fher "\n noeuds ------------"; print Fher "\n $nb_noeuds_final NOEUDS"; print Fher "\n\n\n"; print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' #|NO DU| X | Y | Z |'); print Fher ("\n" . ' #|NOEUD| | | |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n"); for(my $i=1; $i<=$nb_noeuds_final; $i++) { print Fher ("\n ". $i." ". $tab_noeuds_final[$i][0] ." ". $tab_noeuds_final[$i][1] ." ". $tab_noeuds_final[$i][2] ); } print Fher "\n\n\n"; #listes de noeuds dans .her print Fher "\n\n\n"; print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' # references de noeuds |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n"); foreach my $nom_liste (@{$ordre_listes{'NOEUDS'}}) { next if(not defined($ref_listes[0]->{$nom_liste}[0])); ecrire_liste_N_E(*Fher, " ".$nom_liste, @{$ref_listes[0]->{$nom_liste}}); print Fher "\n"; } print Fher "\n" if($#{$ordre_listes{'NOEUDS'}} != -1); #elements print Fher ("\n\n\n"); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' # les elements |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' elements ------------'); print Fher "\n $nb_elts ELEMENTS"; print Fher "\n\n\n"; print Fher ("\n" . ' #----------------------------------------------------------------------'); print Fher ("\n" . ' #| NO | | |'); print Fher ("\n" . ' #|ELTS | type element | Noeuds |'); print Fher ("\n" . ' #----------------------------------------------------------------------'); print Fher ("\n"); for(my $i=1; $i<=$nb_elts; $i++) { print Fher " $i $ref_elements->{$i}{'TYPE'} @{$ref_elements->{$i}{'CONNEX'}}\n"; } print Fher "\n" if($#{$ordre_listes{'ELEMENTS'}} != -1); #listes elements print Fher ("\n\n\n"); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' # references elements |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n"); for(my $i=0; $i<=$#{$ordre_listes{'ELEMENTS'}}; $i++) { # rq : $ordre_listes{'ELEMENTS'}[$i] contient le nom de la liste next if(not $ordre_listes{'ELEMENTS'}[$i] =~ /^E/); # uniquement les listes d elements next if(not defined($ref_listes[3]->{$ordre_listes{'ELEMENTS'}[$i]}[0])); ecrire_liste_N_E(*Fher, "\n ".$ordre_listes{'ELEMENTS'}[$i], @{$ref_listes[3]->{$ordre_listes{'ELEMENTS'}[$i]}}); } #listes d aretes print Fher ("\n\n\n"); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' # references aretes elements |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n"); for(my $i=0; $i<=$#{$ordre_listes{'ELEMENTS'}}; $i++) { # rq : $ordre_listes{'ELEMENTS'}[$i] contient le nom de la liste next if(not $ordre_listes{'ELEMENTS'}[$i] =~ /^A/); # uniquement les listes d aretes next if(not defined($ref_listes[1]->{$ordre_listes{'ELEMENTS'}[$i]}[0])); ecrire_liste_A_F(*Fher, "\n ".$ordre_listes{'ELEMENTS'}[$i], @{$ref_listes[1]->{$ordre_listes{'ELEMENTS'}[$i]}}); } #listes de faces print Fher ("\n\n\n"); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n" . ' # references de faces elements |'); print Fher ("\n" . ' #---------------------------------------------------------------'); print Fher ("\n"); for(my $i=0; $i<=$#{$ordre_listes{'ELEMENTS'}}; $i++) { # rq : $ordre_listes{'ELEMENTS'}[$i] contient le nom de la liste next if(not $ordre_listes{'ELEMENTS'}[$i] =~ /^F/); # uniquement les listes de faces next if(not defined($ref_listes[2]->{$ordre_listes{'ELEMENTS'}[$i]}[0])); ecrire_liste_A_F(*Fher, "\n ".$ordre_listes{'ELEMENTS'}[$i], @{$ref_listes[2]->{$ordre_listes{'ELEMENTS'}[$i]}}); } # # NB : pour l instant, pas de listes de points d integration a ecrire dans msh2her.pl # a modifier le jour ou il y en aura (elles sont deja dispos dans @ordre_listes{'ELEMENTS'} ) # close(Fher); }#sub suppr_noeuds_non_references #---------------- #MODIF J. Troufflard #---------------- #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 ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her"); # # avec - $nom_maillage : nom du maillage (si il y en a un. sinon $nom_maillage sera egal a undef # - $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) # $ref_listes[4] : reference vers la table de hashage des listes de points d integration => @{$ref_listes[4]->{'nom liste'}} : (liste des points d integration) # sub lecture_mail_her { my $fher = shift; my $nom_maillage; #------------------------ # lecture du maillage .her #------------------------ #-lecture de noeuds my @tab_noeuds; my $nb_noeuds; my $no_noeud = 0; open(Fher, "<$fher"); while() { if(/^\s*nom_maillage\s+(\S+)/) {$nom_maillage = $1; next;} 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; my %listes_PTI; #-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*[AFEG]/) { $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*[NFEG]/) { $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*[NAEG]/) { $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*[NAFG]/) { $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); open(Fher, "<$fher"); $is_liste_en_cours = 0; while() { chomp; if(/^\s*(G\S+)/) { $nom_liste = $1; $is_liste_en_cours = 1; s/^\s*G\S+\s+//; s/\s+$//; push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_)); } elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAFE]/) { $is_liste_en_cours = 0; } elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) { s/^\s+//; s/\s+$//; push(@{$listes_PTI{$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*[AFEG]/) { $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*[NFEG]/) { $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*[NAEG]/) { $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*[NAFG]/) { $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); open(Flis, "<$flis"); $is_liste_en_cours = 0; while() { chomp; if(/^\s*(G\S+)/) { $nom_liste = $1; $is_liste_en_cours = 1; s/^\s*G\S+\s+//; s/\s+$//; push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_)); } elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAFE]/) { $is_liste_en_cours = 0; } elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) { s/^\s+//; s/\s+$//; push(@{$listes_PTI{$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"; #} #AFFICHAGE DES LISTES DE POINTS D INTEGRATION #foreach my $nom (keys(%listes_PTI)) { # print "$nom : @{$listes_PTI{$nom}}\n"; #} return($nom_maillage, $nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements, \%listes_NOEUDS, \%listes_ARETES, \%listes_FACES, \%listes_ELEMENTS, \%listes_PTI); }#sub lecture_mail_her #MODIF J. Troufflard #---------------- #sub pour ecrire une liste de noeuds et elements (on indique un handle de fichier deja ouvert) sub ecrire_liste_N_E { my $handle = shift; my $nom_liste = shift; my @liste_no = @_; my $cpt; my $cpt_max = 15; my $nb_blancs; $nb_blancs = ""; $nb_blancs .= " " for(1 .. length($nom_liste)); $_ = shift(@liste_no); print $handle "$nom_liste $_"; $cpt = 1; foreach my $no (@liste_no) { $cpt++; if($cpt == 1) {print $handle "$nb_blancs $no";} elsif($cpt == $cpt_max) {print $handle " $no\n"; $cpt = 0;} else {print $handle " $no";} } print $handle "\n" if($cpt != $cpt_max); }#sub ecrire_liste_noeuds #MODIF J. Troufflard #---------------- #sub pour ecrire une liste d aretes et faces (on indique un handle de fichier deja ouvert) sub ecrire_liste_A_F { my $handle = shift; my $nom_liste = shift; my @liste_no = @_; my $cpt; my $cpt_max = 30; my $nb_blancs; $nb_blancs = ""; $nb_blancs .= " " for(1 .. length($nom_liste)); $_ = shift(@liste_no); print $handle "$nom_liste $_"; $cpt = 1; foreach my $no (@liste_no) { $cpt++; if($cpt == 1) {print $handle "$nb_blancs $no";} elsif($cpt == $cpt_max) {print $handle " $no\n"; $cpt = 0;} else {print $handle " $no";} } print $handle "\n" if($cpt != $cpt_max); }#sub ecrire_liste_A_F