Projet

Général

Profil

Perl script : viewing Herezh meshes in Gmsh » hz_visuMail.pl

version 1.026 (ajout option -disable_lis_i : desactiver le fichier .lis du i-ème maillage; ajout option -wireframe : visualisation uniquement des arêtes au démarrage de Gmsh) - Julien Troufflard, 03/03/2017 09:34

 
#!/usr/bin/env perl
use strict;
use warnings;
use English;
use File::Spec::Functions qw(rel2abs);
use File::Basename;
my $NOM_PROG = basename $PROGRAM_NAME;


my $VERSION = '1.026';
#####################################################################################################
# script pour visualiser un ou plusieurs maillages dans Gmsh #
# version 1.00 : version initiale #
# (version testee sur : MacOSX Darwin, Linux Debian) #
# version 1.01 : which du package File::Which n est plus utilise pour verifier l existence #
# d une commande (pour eviter une erreur dans le cas ou ce package n est pas #
# installe). A la place, on regarde la variable $PATH via la subroutine verif_cmd() #
# (version testee sur : MacOSX Darwin, Linux Debian, Linux Mint 16) #
# version 1.02 : modification de la facon dont le calcul Herezh temporaire est lance de maniere #
# a faciliter l arret du programme avec ctrl+c. Le signal ctrl+c est capture via #
# $SIG{INT} et le calcul Herezh est lance dans un processus fils fork() pour #
# permettre l application de la subroutine pointee par $SIG{INT} #
# ( cette modif permet de stopper l execution du programme dans le cas ou #
# l utilisateur n a pas envie d attendre la fin d un calcul Herezh trop long ) #
# version 1.021 : (((rien de special))) #
# 1) il y a avait un "lectureCommandesVisu" inutile dans le calcul temporaire #
# mais qui ne posait pas de souci. Il est supprime par securite #
# 2) ajout du pragma "use warnings;" et donc en consequence => legere modif de #
# la subroutine lecture_mail_her() pour debugger quelques warnings #
# version 1.022 : ajout de ./ dans l appel system() d execution de Herezh via lien symbolique #
# (car dans le cas ou le repertoire courant ne figure pas dans les PATH, ce lien #
# symbolique qui est cree dans le repertoire courant n etait pas trouve et donc, #
# Herezh n etait pas lance) #
# version 1.023 : ajout de l option -quit (execution normale du script mais sans lancement de la #
# visu gmsh). Typiquement, cette option est utilisee conjointement a -saveVisu, ce #
# qui permet de generer le fichier de visu, le sauvegarder et quitter #
# version 1.024 : ajout option -lis_[i] : ajout d un fichier .lis pour le maillage i #
# exemple : -lis_2 toto.lis => ajoute les references de toto.lis pour le 2eme #
# maillage #
# exemple : -lis_3 toto.lis -lis_3 titi.lis => ajoute les references de toto.lis #
# et titi.lis pour le 3eme maillage #
# version 1.025 : ajout option -disable_F (desactivation des listes de reference de faces pour #
# permettant de mieux voir les numeros d elements dans le cas des elements 2D) #
# version 1.026 : 1) ajout option -disable_lis_[i] (desactivation du fichier .lis du maillage i; #
# ce qui n empeche d utiliser l option -lis_[i] pour activer d autres .lis) #
# 2) ajout option -wireframe (desactiver la vue des faces des elements 2D et 3D au #
# demarrage de gmsh) #
#####################################################################################################




# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# VARIABLES QUE L UTILISATEUR PEUT ETRE AMENE A RENSEIGNER #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# les variables $exeHZ et $exeGMSH servent a imposer le choix des executables Herezh et Gmsh
# (rq : les alias shell ne fonctionneront pas)
#
#commande HZ++ definie par l utilisateur (modifiable egalement avec l option -exeHZ)
my $exeHZ; # = 'mon_executable_a_moi';
#commande gmsh definie par l utilisateur (modifiable egalement avec l option -exeGMSH)
my $exeGMSH; # = 'mon_executable_a_moi';


#commande Herezh par defaut selon la plateforme
# rq : ces variables seront utilisees uniquement si la variable $exeHZ n a pas ete definie
my $EXE_HZ_Linux64bits = 'HZppfast64';#linux 64 bits
my $EXE_HZ_MacOSX = 'HZppfast_Vn-1';#MacOSX
my $EXE_HZ_autres = 'HZppfast';#tous les autres systemes
#commande gmsh par defaut (quelque soit la plateforme)
# rq : cette variable sera utilisee uniquement si la variable $exeGMSH n a pas ete definie
my $exeGMSH_defaut = 'gmsh';

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# FIN VARIABLES UTILISATEUR #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #




sub affichage_aide {
use Text::Wrap;
#config du package Text::Wrap
$Text::Wrap::columns = 81;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1) dans le cas ou utilise wrap

#indentation de longueur $NOM_PROG
my $indent_NOM_PROG = ""; $indent_NOM_PROG .= " " for(1 .. length($NOM_PROG));

print "----------------------------------------\n";
print " script $NOM_PROG (version $VERSION)\n";
print "----------------------------------------\n";
print "\n";
print "But : visualiser des maillages Herezh avec Gmsh\n";
print "\n";
print "Usage 1 : mode interactif\n";
print " > $NOM_PROG\n";
print "Usage 2 : lancement avec arguments\n";
print wrap(" "," $indent_NOM_PROG ", "> $NOM_PROG [-h|help] [-v] [-exeHZ path_HZ] [-exeGMSH path_GMSH] [-saveVisu] fher_1 [fher_2 .. fher_N]\n");
print "\n";
print "Arguments :\n";
print " o fic_1 : 1er maillage .her\n";
print " o [fher_2 .. fher_N] : maillages .her supplementaires eventuels\n";
print "\n";
print "Fonctionnement :\n";
print wrap(" ", " ", "$NOM_PROG lance un calcul herezh pour creer un fichier .msh ",
"qui est ensuite visualise dans Gmsh. La visualisation des references est ",
"desactivee a l ouverture (exceptee la derniere vue qui est specialement ",
"creee par ce script pour afficher les elements en vue solide) ",
"Le code couleur pour les references est :\n");
print wrap(" ", " ", "- reference de noeuds => rouge\n",
"- reference d aretes => jaune\n",
"- reference de faces => vert\n",
"- reference d elements => bleu\n",
"- reference de points d integration => mauve\n");
print wrap(" ", " ", "Dans le cas de maillages avec beaucoup d elements, la preparation des fichiers ",
"peut prendre du temps. Il est alors conseille d utiliser l option -saveVisu pour ",
"conserver les fichiers de visualisation pour pouvoir les reouvrir ulterieurment ",
"sans avoir a reexecuter ce script.\n");
print "\n";
print "Options :\n";
print " -v : affichage du numero de version\n";
print "\n";
print wrap(" ", " ", "-exeHZ path_HZ : choisir l executable Herezh++. Le calcul Herezh se ",
"fera avec l executable path_HZ\n",
"par defaut : linux 64 bits => path_HZ=HZppfast64\n",
" MacOSX (darwin) => path_HZ=HZppfast_Vn-1\n",
" autres => path_HZ=HZppfast\n",
"(a noter que les alias shell ne fonctionneront pas)\n",
"(a noter que cette option fonctionne aussi en mode interactif)\n");
print "\n";
print wrap(" ", " ", "-exeGMSH path_GMSH : choisir l executable Gmsh. La visualisation Gmsh se ",
"fera avec l executable path_GMSH\n",
"par defaut : path_GMSH=gmsh\n",
"(a noter que les alias shell ne fonctionneront pas)\n",
"(a noter que cette option fonctionne aussi en mode interactif)\n");
print "\n";
print wrap(" ", " ", "-saveVisu : sauvegarde des fichiers .geo et .msh de visu\n");
print "\n";
print wrap(" ", " ", "-quit : executer le script sans lancer la visualisation Gmsh\n");
print "\n";
print wrap(" ", " ", "-lis_i fic.lis : ajout de fichiers de listes de reference pour le maillage f_her_i ",
"(cette option peut etre repetee autant de fois que necessaire)\n",
"exemple : $NOM_PROG -lis_1 mon_fic.lis maillage.her\n");
print "\n";
print wrap(" ", " ", "-disable_F : desactiver l affichage des listes de reference de faces\n");
print "\n";
print wrap(" ", " ", "-disable_lis_i : desactiver le fichier .lis associe au maillage f_her_i \n",
" exemple : $NOM_PROG -disable_lis_1 maillage.her\n",
" **remarque : l option -lis_i reste disponible si besoin\n");
print "\n";
print wrap(" ", " ", "-wireframe : desactiver la vue concernant l affichage des faces des elements 2D et 3D\n",
"**remarque : la vue reste disponible si besoin dans la visualition gmsh\n");
print "\n";
print "Exemples :\n";
print wrap(" ", " ", "o visualiser les maillages mail1.her et mail2.her :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG mail1.her mail2.her\n");
print wrap(" ", " ", "o visualiser le maillage mail1.her en choisissant l executable Herezh :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -exeHZ HZpp_perso mail1.her\n");
print wrap(" ", " ", "o visualiser le maillage mail1.her et sauvegarder les fichiers de visu :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -saveVisu mail1.her\n");
print wrap(" ", " ", "o visualiser le maillage mail1.her en choisissant l executable Herezh et ",
"l executable Gmsh (exemple dans le cas ou les executables se trouvent ",
"quelque part dans le HOME) :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -exeHZ ~/mon_rep_HZ/HZpp -exeGMSH ~/mon_rep_GMSH/gmsh mail1.her\n");
print wrap(" ", " ", "o creer et sauvegarder les fichiers de visualisation sans lancer la visualisation :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -saveVisu -quit mail1.her\n");
print wrap(" ", " ", "o visualiser 2 maillages en ajoutant 2 fichiers .lis supplementaires pour le 2eme maillage :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -lis_2 ref_sup.lis -lis_2 autres_ref_sup.lis mail1.her mail2.her\n");
print wrap(" ", " ", "o visualiser 1 maillage en ajoutant 1 fichier .lis supplementaire et en desactivant le .lis principal :\n");
print wrap(" ", " $indent_NOM_PROG ", "> $NOM_PROG -lis_1 ref_sup.lis -disable_lis_1 mail1.her\n");
print "\n";
print "Auteur :\n";
print " TROUFFLARD Julien\n";
print " julien.troufflard\@univ-ubs.fr\n";
print " julien.troufflard\@free.fr\n";
print "----------------------------------------\n";
}



#------------------------------------
#option -h ou -help => affichage de l aide et arret
#------------------------------------
# rq : insensible a la casse
foreach my $arg (@ARGV) {
if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
affichage_aide();
exit;
}
}

#------------------------------------
#option -v => affichage de la version et arret
#------------------------------------
foreach my $arg (@ARGV) {
if($arg eq '-v') {
print "\n $NOM_PROG : version $VERSION\n\n";
exit;
}
}



#------------------------------------
#recuperation des arguments et options
#------------------------------------
my @liste_fher;#liste des maillages
my $is_opt_saveVisu = 0;#indicateur de l option -saveVisu (sauvegarde des fichiers .geo et _Gmsh.msh de visualisation)
my $is_opt_quit = 0;#indicateur de l option -quit (execution normale du script excepte le fait que la visu Gmsh n est pas lancee)
my %FLIS_i;#table des .lis supplementaires indiques par une ou plusieurs options -lis_i
# fonctionnement de la variable :
# $FLIS_i{no maillage}{'IS_LIS_SUP'} = 1 ou non defini (sert d indicateur pour savoir si il y a des .lis supplementaires)
# @{ $FLIC_i{no maillage}{'LISTE'} } = (liste des fichiers .lis supplementaires)
my $is_opt_disable_F = 0;#indicateur de l option -disable_F (desactiver l affichage des listes de reference de faces)
my @DISABLE_LIS_i;#liste des .lis a activer en fonction du numero du maillage (option -disable_lis_i)
my $is_opt_wireframe = 0;#indicateur de l option -wireframe (desactiver la vue des faces des elements 2D et 3D au demarrage de gmsh)


#on parcourt la liste des arguments (on traite les options connues et on stocke les autres dans @args)
my $opt;
my @args;
while($#ARGV != -1) {
$opt = shift(@ARGV);

#option -exeHZ
if($opt eq '-exeHZ') {
($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-exeHZ) : pas assez d arguments donnes pour cette option...\n\n";
$exeHZ = shift(@ARGV);
}
#option -exeGMSH
elsif($opt eq '-exeGMSH') {
($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-exeGMSH) : pas assez d arguments donnes pour cette option...\n\n";
$exeGMSH = shift(@ARGV);
}
#option -saveVisu
elsif($opt eq '-saveVisu') {
$is_opt_saveVisu = 1;
}
#option -quit
elsif($opt eq '-quit') {
$is_opt_quit = 1;
}
#option -lis_i
elsif($opt =~ /^-lis_(\d+)$/) {
my $no_maillage = $1;
($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-lis_$no_maillage) : pas assez d arguments donnes pour cette option...\n\n";
my $flis_sup = shift(@ARGV);
(-e $flis_sup) or die "\nErreur (prog:$NOM_PROG,opt:-lis_$no_maillage) : fichier $flis_sup introuvable...\n\n";
#on retranche 1 au numero de maillage car plus loin dans le script, les numeros de maillage commence a 0 (liste de 0 a N-1 maillages)
$no_maillage--;
#indicateur de presence d au moins 1 fichier .lis supplementaire pour le maillage n? $no_maillage
$FLIS_i{$no_maillage}{'IS_LIS_SUP'} = 1;
#ajout du fichier dans la liste
push(@{ $FLIS_i{$no_maillage}{'LISTE'} }, $flis_sup);
}
#option -disable_F
elsif($opt eq '-disable_F') {
$is_opt_disable_F = 1;
}
#option -disable_lis_i
elsif($opt =~ /^-disable_lis_(\d+)$/) {
my $no_maillage = $1;
#on retranche 1 au numero de maillage car plus loin dans le script, les numeros de maillage commence a 0 (liste de 0 a N-1 maillages)
$no_maillage--;
$DISABLE_LIS_i[$no_maillage] = 1;
}
#option -wireframe
elsif($opt eq '-wireframe') {
$is_opt_wireframe = 1;
}

#cas d une option inconnue
elsif($opt =~ /^-/) {
warn "**Attention : option $opt inconnue (on ignore cette option)...\n";
}

#autres arguments
else {
push(@args,$opt);
}
}#while($#ARGV != -1)


#---------------------
#verif de l executable Herezh
#---------------------
#si la variable $exeHZ n a pas ete renseigne au prealable => on selectionne l executable par defaut en fonction de la plateforme
if(not defined($exeHZ)) {
#- - - - - -
#type de plateforme
#- - - - - -
my $type_OS;
#-avec uname
if(verif_cmd('uname')) {
$type_OS = qx(uname -a);
chomp($type_OS);
}
#-sinon : warning (OS inconnue)
else {warn "**Attention : impossible de saisir le type de systeme d exploitation avec uname -a ...\n";}

#selection de l executable Herezh
#-linux 64 bits
if($type_OS =~ /linux/i and $type_OS =~ /x86_64/i) {$exeHZ = $EXE_HZ_Linux64bits;}
#-MacOSX (darwin)
elsif($type_OS =~ /darwin/i) {$exeHZ = $EXE_HZ_MacOSX;}
#-tous les autres (y compris linux 32 bits)
else{$exeHZ = $EXE_HZ_autres;}
}
#verif de l executable Herezh
verif_cmd($exeHZ) or die "\n**Erreur (prog:$NOM_PROG) : executable Herezh ($exeHZ) introuvable (pour eviter cette erreur : vous pouvez soit utiliser l option -exeHZ, soit renseigner directement la commande Herezh dans la variable \$exeHZ au debut du script)...\n\n";

#---------------------
#verif de l executable Gmsh
#---------------------
#si la variable $exeGMSH n a pas ete renseigne au prealable => on selectionne l executable par defaut
$exeGMSH = $exeGMSH_defaut if(not defined($exeGMSH));
#verif de l executable Gmsh
verif_cmd($exeGMSH) or die "\n**Erreur (prog:$NOM_PROG) : executable Gmsh ($exeGMSH) introuvable (pour eviter cette erreur : vous pouvez soit utiliser l option -exeGMSH, soit renseigner directement la commande Gmsh dans la variable \$exeGMSH au debut du script)...\n\n";





#---------------------
#liste des maillages (on en profite pour faire des verifs sur la validite du fichier)
#---------------------
#
# la liste @args va servir de liste temporaire pour la saisie des noms de fichier
#
#cas avec arguments
if($#args >= 0) {
#rien a faire pour l instant (la liste @args a deja ete remplie par les arguments)
}
#cas en mode interactif (on remplit la liste @args avec un menu interactif)
else {
print "\nChoix des maillages a visualiser :\n";
print " (taper liste pour afficher la liste actuelle)\n";
my $choix = -1;
while() {
print " Donner un nom de maillage (f pour finir) : ";
$choix = <STDIN>; chomp($choix);
next if($choix eq '');#cas ou l utilisateur a tape "Entree"

#choix f => on arrete la saisie
last if($choix eq 'f');

if($choix eq 'liste') {
print " Liste actuelle :\n @args\n\n" if($choix eq 'liste');
next;
}

push(@args, $choix);
}
print "\n";
}
#-verif de la validite des maillages
foreach my $arg (@args) {
$arg .= '.her' if(not $arg =~ /\.her$/);#rajout de l extension .her si manquante
#existence du fichier
(-e $arg) or do {warn "**Attention : fichier $arg introuvable (on ignore ce fichier)...\n"; next;};
#ouverture du fichier
open(FIC, "<$arg") or do {warn "**Attention : impossible d ouvrir le fichier $arg (on ignore ce fichier)...\n"; next;};
#est-ce un maillage Herezh ? (verif par la presence des mots noeuds et NOEUDS)
my ($is_noeuds, $is_NOEUDS) = (0,0);
while(<FIC>) {
$is_noeuds = 1 if(/^\s*noeuds/o);
$is_NOEUDS = 1 if(/^\s*\d+\s+NOEUDS/o);
last if($is_NOEUDS);
}
close(FIC);
$is_noeuds or do {warn "**Attention : le fichier $arg ne contient pas le mot \"noeuds\" (on ignore ce fichier)...\n"; next;};
$is_NOEUDS or do {warn "**Attention : le fichier $arg ne contient pas le mot \"NOEUDS\" (on ignore ce fichier)...\n"; next;};

#fichier ok => ajout a la liste
push(@liste_fher, $arg);
}

#si a ce stade, la liste des maillages est vide => on arrete le programme
($#liste_fher > -1) or die "\nArret du programme car aucun maillage valide n a ete fourni...\n\n";



#---------------------
#verif des maillages (constitution de la liste des noms de maillage)
#---------------------
print " verification des maillages...\n";
my @liste_nom_maillage;
#-verif 1 : si il y a un seul maillage et qu il n a pas de nom, on indique "premier_maillage" dans la liste des noms de maillages
if($#liste_fher == 0) {
my $nom_maillage = '';
open(FIC, "<$liste_fher[0]") or die "\n**Erreur (prog:$NOM_PROG) : impossible d ouvrir le fichier $liste_fher[0] ...\n\n";
while(<FIC>) {
last if(/^\s*noeuds/o);
next if(not /^\s*nom_maillage\s+(\S+)/o);
$nom_maillage = $1;
last;
}
close(FIC);
$nom_maillage = 'premier_maillage' if($nom_maillage eq '');
push(@liste_nom_maillage, $nom_maillage);
}

#-verif 2 : si il y a plusieurs maillages, il faut qu il ait chacun un nom_maillage different (sinon arret du programme)
if($#liste_fher > 0) {
my $is_maillage_ok = 1;
foreach my $fher (@liste_fher) {
my $nom_maillage = '';
open(FIC, "<$fher") or die "\n**Erreur (prog:$NOM_PROG) : impossible d ouvrir le fichier $fher ...\n\n";;
while(<FIC>) {
next if(not /^\s*nom_maillage\s+(\S+)/o);
$nom_maillage = $1;
last;
}
close(FIC);
push(@liste_nom_maillage, $nom_maillage);
}

my @maillages_deja_traites; for(my $i=0; $i<=$#liste_nom_maillage; $i++) {$maillages_deja_traites[$i] = 0;}
for(my $i=0; $i<=$#liste_nom_maillage; $i++) {
next if($maillages_deja_traites[$i]);

#cas d un maillage sans nom
if($liste_nom_maillage[$i] eq '') {
warn "**Erreur (prog:$NOM_PROG) : le maillage $liste_fher[$i] n a pas de nom (nom_maillage non specifie)...\n";
$is_maillage_ok = 0;
next;
}

#cas d un maillage ayant le meme nom qu un ou plusieurs autres maillages
my @liste_maillages_meme_nom = ();
for(my $j=$i+1; $j<=$#liste_nom_maillage; $j++) {
if($liste_nom_maillage[$i] eq $liste_nom_maillage[$j]) {
$maillages_deja_traites[$j] = 1;
push(@liste_maillages_meme_nom, $liste_fher[$j]);
}
}
if($#liste_maillages_meme_nom > -1) {
warn "**Erreur (prog:$NOM_PROG) : les maillages suivants ont le meme nom => $liste_fher[$i] @liste_maillages_meme_nom\n";
$is_maillage_ok = 0;
}
}

#arret du programme si on a trouve des maillages sans nom ou des noms utilises plusieurs fois
$is_maillage_ok or die "\nArret du programme a cause d un probleme sur les noms de maillages...\n\n";
}


#---------------------
#listes des elements 1D, 2D et 3D (pour affecter des lois de type LOI_RIEN)
#---------------------
print " preparation du calcul Herezh...\n";
#-prefixes et suffixe pour la reconnaissance des elements 1D, 2D et axisymetriques
my @PREFIXE_1D = qw(POUT);
my @PREFIXE_2D = qw(TRIA QUAD);
my @SUFFIXE_AXI = qw(_AXI);

#-table de hachage pour definir pour chaque maillage, la liste des elements 1D, 2D, 3D (rq : les elements AXI sont consideres comme 3D car il necessite une loi 3D)
my %TAB_DIM_LOI;#@{$TAB_DIM_LOI{indice maillage}{dim loi}} = (liste elements) (par exemple, pour le premier maillage => @{$TAB_DIM_LOI{0}{'3D'}} = (1,5,10)

#on boucle sur les maillages pour constituer les listes d elements par dimension de loi de comportement pour chaque maillage
# rq : on en profite pour reperer si il y a au moins 1 element 1D et au moins un element 2D (pour savoir si il faudra renseigner le mot-cle sections et epaisseurs)
my $is_elt_1D = 0;#indicateur de la presence d au moins 1 element 1D
my $is_elt_2D = 0;#indicateur de la presence d au moins 1 element 2D
my $nb_elts_tot = 0;
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
#saisie des elements
my ($nb_elts, $ref_elements);
($_, $_, $_, $nb_elts, $ref_elements) = lecture_mail_her($liste_fher[$no_mail]);
$nb_elts_tot += $nb_elts;
my @ELEM_1D = ();
my @ELEM_2D = ();
my @ELEM_3D = ();
ELEM:for(my $i=1; $i<=$nb_elts; $i++) {
#verif si element AXI (=> loi LOI_RIEN3D )
foreach my $suffixe (@SUFFIXE_AXI) {
@_ = split(/\s+/, $ref_elements->{$i}{'TYPE'});
if($_[0] =~ /$suffixe\s*$/) {
push(@ELEM_3D, $i);
next ELEM;
}
}
#verif si element 1D (=> loi LOI_RIEN1D )
foreach my $prefixe (@PREFIXE_1D) {
if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
push(@ELEM_1D, $i);
$is_elt_1D = 1;
next ELEM;
}
}
#verif si element 2D (=> loi LOI_RIEN2D_C )
foreach my $prefixe (@PREFIXE_2D) {
if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
push(@ELEM_2D, $i);
$is_elt_2D = 1;
next ELEM;
}
}
#sinon, c est un element 3D (=> loi LOI_RIEN3D )
push(@ELEM_3D, $i);
}#FIN BOUCLE SUR LES ELEMENTS DU MAILLAGE indice $no_mail

#remplissage de la table pour ce maillage
push(@{$TAB_DIM_LOI{$no_mail}{'1D'}}, @ELEM_1D);
push(@{$TAB_DIM_LOI{$no_mail}{'2D'}}, @ELEM_2D);
push(@{$TAB_DIM_LOI{$no_mail}{'3D'}}, @ELEM_3D);

}#FIN BOUCLE SUR LES MAILLAGES



#--------------------
#nom des fichiers .info, .CVisu, _Gmsh.msh et .geo temporaires (on s assure qu ils n existent pas deja)
#--------------------
my $racine_fic_tmp = $NOM_PROG; $racine_fic_tmp =~ s/\.\S+$//;
my $no = 0;
$racine_fic_tmp .= "_$no";
my $finfo = "$racine_fic_tmp.info";#fichier de calcul temporaire
my $fCVisu = "$racine_fic_tmp.CVisu";#.CVisu associe
my $fGmsh = "$racine_fic_tmp\_Gmsh.msh";#.msh qui va etre cree apres calcul
my $fgeo = "$racine_fic_tmp.geo";#.geo qui sera utilise pour lancer la visu

while(-e $finfo or -e $fCVisu or -e $fGmsh or -e $fgeo) {
$no++;
$racine_fic_tmp = $NOM_PROG; $racine_fic_tmp =~ s/\.\S+$//;
$racine_fic_tmp .= "_$no";
$finfo = "$racine_fic_tmp.info";
$fCVisu = "$racine_fic_tmp.CVisu";
$fGmsh = "$racine_fic_tmp\_Gmsh.msh";
$fgeo = "$racine_fic_tmp.geo";
}
#-memorisation des eventuels fichiers deja existants qui commencent comme le fichier .info (pour ne pas les effacer a la fin du script)
my @liste_fic_a_ne_pas_effacer = glob("$racine_fic_tmp*");


#####################################################################
# a partir de maintenant, le signal ctrl+c est recupere et gere par une subroutine pour s assurer d effacer tous les fichiers
# temporaires et de tuer l eventuel processus Herezh si l utilisateur fait un ctrl+c (typiquement pour arreter un calcul Herezh trop long)
#####################################################################

#-on reperera le processus Herezh via un nom de lien symbolique genere a partir du PID du processus de ce script Perl $PID (qui sera donc unique a priori)
my $HZ_symbolic_link = 'HZppfast_'.$PID.'_hz_visuMail';
my $absolute_path_cmd = absolute_path_cmd($exeHZ);
#-creation du lien symbolique
system("ln -s $absolute_path_cmd $HZ_symbolic_link");
#-capture du signal ctrl+c
$SIG{INT} = sub {
#kill des processus Herezh (on les repere grace au nom du lien symbolique $HZ_symbolic_link
foreach my $processus (qx(ps -U $ENV{USER} -o pid,%cpu,command | grep $HZ_symbolic_link | grep -v grep)) {
next if(not $processus =~ /^\s*(\d+)/);
kill("TERM", $1);
}

#destruction des fichiers temporaires
efface_fic_temporaires();

die "\nArret du programme a cause d un ctrl+c ...\n\n";
};




#---------------------
#ecriture du .info
#---------------------
open(FIC, ">$finfo");
print FIC "dimension 3\n\n";

print FIC "niveau_commentaire 1\n\n";

#on choisit de lancer le calcul en dynamique_explicite en prevision des maillages a grand nombre de noeuds (plus rapide que non_dynamique pour faire un increment)
print FIC "TYPE_DE_CALCUL\ndynamique_explicite\n";

#ecriture des maillages et de references d elements speciales
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
my $fher = $liste_fher[$no_mail];
my $flis = $fher; $flis =~ s/.her$/.lis/;
print FIC "\n< $fher\n";
print FIC "< $flis\n" if(-e $flis and not defined $DISABLE_LIS_i[$no_mail]);#inclusion du .lis si il existe (et si l option -disable_lis_i n a pas ete utilisee pour ce maillage)
#ajout de .lis supplementaire si l option -lis_i a ete utilisee
if(defined $FLIS_i{$no_mail}{'IS_LIS_SUP'}) {
print FIC "< $_\n" for @{ $FLIS_i{$no_mail}{'LISTE'} };
}
#set d elements speciaux en fonction de la dimension de la loi de comportement
# rq : on utilise une subroutine qui ecrit les references avec 15 elements max par ligne (sinon bug Herezh si il y a trop d elements par ligne)
foreach my $dim ('1D', '2D', '3D') {
next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
ecrire_liste_N_E(*FIC, "E_tmp_visu_elem_$dim", @{$TAB_DIM_LOI{$no_mail}{$dim}});
}
}

print FIC "\nchoix_materiaux\n";
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
#choix materiau par dimension de loi
foreach my $dim ('1D', '2D', '3D') {
next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
print FIC "nom_mail= $liste_nom_maillage[$no_mail] E_tmp_visu_elem_$dim MAT$dim\n";
}
}

print FIC "\nmateriaux\n";
print FIC "MAT1D LOI_RIEN1D\nMAT2D LOI_RIEN2D_C\nMAT3D LOI_RIEN3D\n\n";

print FIC "masse_volumique\n";
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
foreach my $dim ('1D', '2D', '3D') {
next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
print FIC "nom_mail= $liste_nom_maillage[$no_mail] E_tmp_visu_elem_$dim 1.\n";
}
}

#sections pour les eventuels elements 1D
if($is_elt_1D) {
print FIC "\nsections\n";
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
next if($#{$TAB_DIM_LOI{$no_mail}{'1D'}} == -1);#pas d ecriture si aucun element de dimension $dim
print FIC "nom_mail= $liste_nom_maillage[$no_mail] E_tmp_visu_elem_1D 1.\n";
}
}

#epaisseurs pour les eventuels elements 2D
if($is_elt_2D) {
print FIC "\nepaisseurs\n";
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
next if($#{$TAB_DIM_LOI{$no_mail}{'2D'}} == -1);#pas d ecriture si aucun element de dimension $dim
print FIC "nom_mail= $liste_nom_maillage[$no_mail] E_tmp_visu_elem_2D 1.\n";
}
}

print FIC "\ncharges\n\n";
print FIC "blocages\n\n";

#controle => un seul increment
print FIC "controle\n";
print FIC "DELTAt 1.\n";
print FIC "TEMPSFIN 1.\n";
print FIC "SAUVEGARDE 0\n";
print FIC "MAXINCRE 1\n";

print FIC "\npara_pilotage_equi_global\n\n";

print FIC "para_syteme_lineaire\n\n";

print FIC "para_affichage\nFREQUENCE_SORTIE_FIL_DU_CALCUL 1\n\n";

print FIC "resultats pas_de_sortie_finale_\nCOPIE 0\n\n";

print FIC "_fin_point_info_\n";
close(FIC);


#---------------------
#ecriture du .CVisu
#---------------------
open(FIC, ">$fCVisu");
print FIC "
debut_fichier_commande_visu

debut_visualisation_Gmsh
debut_maillage_initial
actif 1
pseudo-homothetie_sur_les_maillages_ 0
visualisation_references_sur_les_maillages_ 1
fin_maillage_initial

debut_choix_maillage
actif 0
1";
for(my $i=1; $i<=$#liste_fher; $i++) {$_ = $i + 1; print FIC " $_";}
print FIC " fin_choix_maillage
fin_visualisation_Gmsh

fin_fichier_commande_visu
";
close(FIC);



#---------------------
#lancement du calcul
#---------------------
#-on lance le calcul avec redirection dans un fichier .log (au cas ou le calcul a plante => on propose la lecture de ce .log a l utilisateur)
my $fredir = "$racine_fic_tmp.log";
print " creation du fichier _Gmsh.msh (calcul Herezh en cours)...\n";
system("rm -f $fGmsh $fredir");
system("echo \'#\' > $fredir; echo \'#fichier genere suite a l execution du script $NOM_PROG\' >> $fredir; echo \'#\' >> $fredir; echo \'\' >> $fredir");#affichage d un en-tete dans le fichier .log pour indiquer que ce fichier a ete cree lors de l execution de ce script
#-lancement de Herezh dans un processus fils pour permettre un ctrl+c a l utilisateur (et donc le traitement de la subroutine pointee par $SIG{INT})
my $pid_fils = fork();
#---------- processus fils
if($pid_fils == 0) {
system("echo n | ./$HZ_symbolic_link -f $finfo >> $fredir");#on lance avec "echo n" pour repondre automatiquement "non" au cas ou il y a une erreur de calcul Herezh
exit;
}
#---------- fin du processus fils
#attente de la fin du processus fils par son pere
waitpid($pid_fils, 0);


#cas ou la calcul n a pas fonctionne (si le fichier _Gmsh.msh n a pas ete cree)
# => on propose a l utilisateur de visualiser le .log pour savoir ce qui s est passe
if(not -e $fGmsh) {
print "\n**Erreur (prog:$NOM_PROG) : le calcul Herezh++ n a pas fonctionne (le fichier pour Gmsh n a pas ete cree)...\n\n";
my $choix = -1;
while($choix ne 'o' and $choix ne 'n') {
print " Voulez-vous visualiser l affichage Herezh++ du calcul ? (o/n) ";
$choix = <STDIN>; chomp($choix); $choix = lc($choix);
}
if($choix eq 'o') {
print " => voir fichier $fredir\n";
#on ajoute le fichier .log a la liste de fichiers a ne pas effacer
push(@liste_fic_a_ne_pas_effacer, $fredir);
}

#destruction des fichiers temporaires
efface_fic_temporaires();

#arret du programme
die "\nArret du programme a cause d un probleme d execution Herezh++...\n\n";
}


#---------------------
#lecture du .msh et reecriture pour modifier les couleurs selon le type de reference (noeud, arete, face, element)
# et pour saisir la liste des types de reference dans l ordre du fichier .msh pour affecter des options Gmsh suivant le type de reference
#---------------------

#on affecte une isovaleur par couleur :
# - 0 => gris (dedie a l affichage du maillage)
# - 1 => bleu (dedie a l affichage des refs d elements)
# - 2 => vert (dedie a l affichage des refs de faces)
# - 3 => jaune (dedie a l affichage des refs d aretes)
# - 4 => rouge (dedie a l affichage des refs de noeuds)
# - 5 => mauve (dedie a l affichage des refs de points d integration)
my $couleur_RGB_maillage = '{190, 190, 190, 255}';#gris
my $couleur_RGB_element = '{ 0, 150, 255, 255}';#bleu
my $couleur_RGB_face = '{ 0, 255, 0, 255}';#vert
my $couleur_RGB_arete = '{240, 200, 0, 255}';#jaune
my $couleur_RGB_noeud = '{255, 0, 0, 255}';#rouge
my $couleur_RGB_pti = '{238, 130, 238, 255}';#mauve

#jeu de couleur par type de reference (on utilise les isovaleur gmsh qui vont du bleu fonce au rouge fonce en passant par le vert et le jaune)
# rq : pour donner une idee des couleur, si on fixe les bornes d isovaleur entre [1:4], on a : 1.7=bleu clair, 2.5=vert, 3=>jaune, 3.6=rouge fonce
my %table_couleur_type_ref = ('pt_integr'=>5, 'noeud'=>4, 'arete'=>3, 'face'=>2, 'element'=>1);

#on va lister les types de ref
my @liste_type_reference;#liste des types de references



#cas de l option -disable_A : on suuprime les listes de reference d aretes
#if($is_opt_disable_A) {
# print " opt:-disable_A => suppression des listes d aretes\n";
# suppr_liste_aretes();
#}

#cas de l option -disable_F : on suuprime les listes de reference de faces
if($is_opt_disable_F) {
print " opt:-disable_F => suppression des listes de faces\n";
suppr_liste_faces();
}



#fichier temporaire
my $ftmp = $fGmsh.rand(9999999); while(-e $ftmp) {$ftmp = $fGmsh.rand(9999999);}
open(FIC, "<$fGmsh");
open(Ftmp, ">$ftmp");
my $is_Element_data = 0;
my $couleur_type_ref;
print " modification du fichier _Gmsh.msh...\n";
while(my $ligne = <FIC>) {

#cas d un element data => on le recopie si il s agit d une reference existant reellement dans les maillages (avec la bonne isovaleur suivant le type de reference)
if($ligne =~ /^\s*\$ElementData\s*$/io) {
my $entete = $ligne;
#on lit jusqu au nom de la reference
while($ligne = <FIC>) {
$entete .= $ligne;
last if($ligne =~ /^\s*\"/o);
}

#selection de l isovaleur en fonction du type de reference
#-ref de noeuds
if($ligne =~ /^\s*\"\s*N(\S+)/o) {
push(@liste_type_reference, 'noeud');
$couleur_type_ref = $table_couleur_type_ref{'noeud'};
}
#-ref d aretes
elsif($ligne =~ /^\s*\"\s*A(\S+)/o) {
push(@liste_type_reference, 'arete');
$couleur_type_ref = $table_couleur_type_ref{'arete'};
}
#-ref de faces
elsif($ligne =~ /^\s*\"\s*F(\S+)/o) {
push(@liste_type_reference, 'face');
$couleur_type_ref = $table_couleur_type_ref{'face'};
}
#-ref d elements
elsif($ligne =~ /^\s*\"\s*E(\S+)/o) {
push(@liste_type_reference, 'element');
$couleur_type_ref = $table_couleur_type_ref{'element'};
}
#-ref de points d integration
elsif($ligne =~ /^\s*\"\s*G(\S+)/o) {
push(@liste_type_reference, 'pt_integr');
$couleur_type_ref = $table_couleur_type_ref{'pt_integr'};
}

#si le nom est une reference d elements creee par ce script => on ne l ecrit pas, on lit jusqu a la fin de l element data et on supprime cette ref de la liste @liste_type_reference
if($ligne =~ /E_tmp_visu_elem_/o) {
while($ligne = <FIC>) {last if($ligne =~ /^\s*\$EndElementData\s*$/io);}
pop(@liste_type_reference);#suppression du dernier element de la liste
}
#si c est une reference reellement dans le maillage, on recopie l en-tete actuel et on recopie l element data avec l isovaleur
else {
$is_Element_data = 1;
print Ftmp $entete;
while($ligne = <FIC>) {
$ligne = "$1 $couleur_type_ref\n" if ($ligne =~ /^\s*(\d+)\s+\d+\s*$/o);
print Ftmp $ligne;
last if($ligne =~ /^\s*\$EndElementData\s*$/io);
}
}
}#if($ligne =~ /^\s*\$ElementData\s*$/io)

#cas general : on recopie simplement la ligne courante
else {
print Ftmp $ligne;
}
}
close(FIC);

#rajout d une ref supplementaire contenant tous les elements pour affichage des faces des elements 2D et 3D (on leur affecte l isovaleur 0, c est a dire couleur gris)
# rq : les elements 1D se retrouvent egalement dans cette ref
print Ftmp "\$ElementData
1
\"Activer/Desactiver vue elements 2D 3D\"
0
3
0
1
$nb_elts_tot\n";
for(my $i=1; $i<=$nb_elts_tot; $i++) {
print Ftmp "$i 0\n";#isovaleur 0
}
print Ftmp "\$EndElementData\n";
close(Ftmp);
system("mv -f $ftmp $fGmsh");



#---------------------
#lancement de la visu Gmsh
#---------------------
#-on cree un fichier .geo pour y ecrire dans l ordre :
# - des options generales a toutes les vues
# - un Merge du .msh
# - des options au cas par cas par type de reference
open(FIC, ">$fgeo");

#variable donnant le nom du fichier .msh
print FIC "//nom du fichier .msh\n";
print FIC "fichier_msh = \"$fGmsh\";\n\n";

#-options generales
print FIC '
Geometry.Light = 0; //desactivation de la lumiere (geometrie)
Mesh.Light = 0; //desactivation de la lumiere (maillage)
View.Light = 0; //desactivation de la lumiere (vue)
Mesh.ColorCarousel = 0; //type de couleur (0=by element type, 1=by elementary entity, 2=by physical entity, 3=by partition)
Geometry.Points = 0; //affichage des points (=0 desactiver, =1 activer)
Mesh.Points = 0; //affichage des noeuds (=0 desactiver, =1 activer)
Mesh.Lines = 1; //affichage des lignes (elements 1D) (=0 desactiver, =1 activer)
Mesh.SurfaceEdges = 1; //affichage des aretes des elements 2D (=0 desactiver, =1 activer)
Mesh.SurfaceFaces = 0; //affichage des faces des elements 2D (=0 desactiver, =1 activer)
Mesh.VolumeEdges = 1; //affichage des aretes des elements 3D (=0 desactiver, =1 activer)
Mesh.VolumeFaces = 0; //affichage des faces des elements 3D (=0 desactiver, =1 activer)
View.Visible = 0; //desactivation de toutes les vues au demarrage
View.ShowScale = 0; //desactivation de la vue de l echelle d isovaleur
View.RangeType = 2; //type de bornes des isovaleurs (2=Custom)
View.CustomMin = 0; //borne mini isovaleur (rappel de la convention adoptee pour $NOM_PROG : 0=>maillage, 1=>element, 2=>face, 3=>arete, 4=>noeud, 5=>point integration)
View.CustomMax = 5; //borne maxi isovaleur
View.PointType = 1; //type d affichage des points (1=3D sphere)
View.PointSize = 4.; //taille des points
View.LineType = 1; //type d affichage des lignes (1=3D cylinder)
View.LineWidth = 3.; //taille des lignes

Mesh.PointSize = 3.; //taille des noeuds
Mesh.Color.Points = {0,0,0}; //on met toutes les couleurs des elements en noir pour que les noeuds et les aretes des elements soient en noir
Mesh.Color.Lines = {0,0,0}; // la couleur des faces des elements 2D et 3D sera geree par l isovaleur 0 (gris) de la derniere View intitulee : Activer/Desactiver vue elements 2D 3D
Mesh.Color.Triangles = {0,0,0};
Mesh.Color.Quadrangles = {0,0,0};
Mesh.Color.Tetrahedra = {0,0,0};
Mesh.Color.Hexahedra = {0,0,0};
Mesh.Color.Prisms = {0,0,0};
Mesh.Color.Pyramids = {0,0,0};
';

#echelle de couleur des isovaleurs
print FIC "//couleur isovaleur : couleur 1 (gris) => isovaleur=0 (maillage)\n";
print FIC "// couleur 2 (bleu) => isovaleur=1 (ref elements)\n";
print FIC "// couleur 3 (vert) => isovaleur=2 (ref faces)\n";
print FIC "// couleur 4 (jaune) => isovaleur=3 (ref aretes)\n";
print FIC "// couleur 5 (rouge) => isovaleur=4 (ref noeuds)\n";
print FIC "// couleur 6 (mauve) => isovaleur=5 (ref points integration)\n";
# valeur isovaleur 0 1 2 3 4 5
print FIC "View.ColorTable = {$couleur_RGB_maillage, $couleur_RGB_element, $couleur_RGB_face, $couleur_RGB_arete, $couleur_RGB_noeud, $couleur_RGB_pti};\n";

#-Merge du fichier .msh (rq : on passe par Sprintf pour utiliser la variable fichier_msh definie au debut)
print FIC "\nMerge Sprintf(fichier_msh);\n\n";

#on indique d afficher la vue speciale qui sert a afficher les faces des elements 2D 3D (la derniere qui a ete cree)
# rq : pour cette vue, on remet l affichage classique pour les points et les lignes
print FIC "//options speciales pour la derniere vue qui sert a l affichage des faces des elements 2D et 3D\n";
my $no_derniere_vue = $#liste_type_reference + 1;#cette vue n est pas enregistree dans la liste, son numero est donc egal a la derniere + 1
#gestion option -wireframe (affichage ou non des faces des elements 2D et 3D au demarrage de gmsh)
if($is_opt_wireframe) {
print FIC "View[$no_derniere_vue].Visible = 0;\n";
}
else {
print FIC "View[$no_derniere_vue].Visible = 1;\n";
}
print FIC "View[$no_derniere_vue].PointType = 0; //type d affichage des points (0=Color dot)\n";
print FIC "View[$no_derniere_vue].PointSize = 3.; //taille des points\n";
print FIC "View[$no_derniere_vue].LineType = 0; //type d affichage des lignes (0=Color segment)\n";
print FIC "View[$no_derniere_vue].LineWidth = 1.; //taille des lignes\n";
print FIC "View[$no_derniere_vue].Explode = 0.999; //on reduit legerement la taille de cette vue pour eviter un conflit de couleur quand on affiche des ref de faces ou d elements par dessus\n";

close(FIC);

#lancement de la visualisation (si l option -quit a ete utilisee)
if($is_opt_quit) {
print "\nopt -quit : pas de visualisation Gmsh...\n\n";
}
else {
print " visu Gmsh en cours (via fichiers $fgeo et $fGmsh)...\n";
system("$exeGMSH $fgeo");
}

#cas de l option -saveVisu (sauvegarde des fichiers .geo et _Gmsh.msh)
if($is_opt_saveVisu) {
#on ajoute les fichiers .geo et _Gmsh.msh a la liste des fichiers a ne pas effacer
push(@liste_fic_a_ne_pas_effacer, $fgeo, $fGmsh);
print "\nopt -saveVisu => Les fichiers $fgeo et $fGmsh ont ete sauvegardes...\n\n";
}

#destruction des fichiers temporaires
efface_fic_temporaires();






#rq : cette subroutine utilise les variables globales $racine_fic_tmp et @liste_fic_a_ne_pas_effacer
sub efface_fic_temporaires {
#on transforme la liste des fichiers a ne pas effacer en table d indicateur (liste @liste_fic_a_ne_pas_effacer)
my %NE_PAS_EFFACER;
foreach my $fic (@liste_fic_a_ne_pas_effacer) {$NE_PAS_EFFACER{$fic} = 1;}
#on saisit la liste actuelle des fichiers qui commencent comme le fichier .info
my @liste_fic_actuelle = glob("$racine_fic_tmp*");
#on efface seulement ceux qui n ont pas d indicateur %NE_PAS_EFFACER
foreach my $fic (@liste_fic_actuelle) {
system("rm -rf $fic") if(not defined($NE_PAS_EFFACER{$fic}));
}
#on efface le fichier inutile "ancienNom"
system("rm -f ancienNom");

#on efface le lien symbolique vers la commande Herezh
system("rm -f $HZ_symbolic_link");
}


#surcouche de which pour traiter le cas d une commande en chemin absolu (cas qui apparemment ne marche pas avec la sub which d origine du package File::Which ??!!?!??!!!)
# N EST PLUS UTILISE DEPUIS LA VERSION 1.01 => A LA PLACE, ON UTILISE LA SUB verif_cmd()
##sub which_absolute {
## use File::Which;
## my $cmd = shift;
## my @path;
## #cas d une commande avec chemin absolu
## if($cmd =~ /^\// and -x $cmd) {
## @path = ($cmd);
## }
## #commande which classique
## push(@path, which($cmd));
## return(@path);
##}

#cette subroutine verifie l existence d une commande dans $PATH (remplace l utilisation de which depuis la version 1.01)
sub verif_cmd {
my $cmd = shift;

#verif directe : est-ce que le fichier existe et est executable
return 1 if(-x $cmd);

#sinon, on regarde dans les path
foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
return 1 if(-x "$path/$cmd");
}

#cas ou la commande n existe pas
return 0;
}

#cette subroutine renvoie le chemin absolu vers une commande (renvoie 0 si commande introuvable ou non executable)
# strategie :
# 1- si la commande commence par "." ou "/" => on renvoie simplement son path absolu
# 2- ensuite, on donne la priorite aux commandes presentes dans $PATH
# par exemple, si la commande toto.x est presente a la fois dans le repertoire courant et dans le repertoire de $PATH /Users/Dupont/bin :
# alors si on passe la commande "toto.x" a cette subroutine, elle va renvoyer le path absolu vers le fichier present dans
# /Users/Dupont/bin. Ce qui force l utilisateur a presciser par un "./" si il veut la commande du repertoire courant "./toto.x"
sub absolute_path_cmd {
my $cmd = shift;

my $absolute_cmd = 0;

#1- commande commence par "." ou "/" => on renvoie simplement son path absolu
if(($cmd =~ /^\./ or $cmd =~ /^\//) and -e $cmd) {
$absolute_cmd = rel2abs($cmd);
}

#2-
#2-a : d abord dans les $PATH
foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
if(-e "$path/$cmd") {
$absolute_cmd = rel2abs("$path/$cmd");
last;
}
}
#2-b : ensuite dans les repertoires hors $PATH
if(-e $cmd) {
$absolute_cmd = rel2abs($cmd);
}


if($absolute_cmd ne "0" and not -x $absolute_cmd) {
warn "**Attention (sub:verif_commande) : la commande $cmd existe ($absolute_cmd) mais le fichier n est pas executable...\n";
return 0;
}

return $absolute_cmd;
}#sub absolute_path_cmd


#ecrire une liste de noeuds ou d elements
# rq : a priori, si on met trop de noeuds/elements sur une meme ligne, Herezh plante (donc on se limite 15 nombres par ligne)
sub ecrire_liste_N_E {
my $handle = shift;#le handle de fichier est passe par une variable
my $nom_liste = shift;
my @liste_no = @_;#liste des noeuds ou d elements

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


#----------------
#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(<Fher>) {
if(/^\s*nom_maillage\s+(\S+)/o) {$nom_maillage = $1; next;}
next if(not /(\d+)\s+NOEUDS/o);
$nb_noeuds = $1;
last;
}
while(<Fher>) {
last if($no_noeud == $nb_noeuds);
next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/o);
$no_noeud = $1;
@{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
}

#-lecture des elements
my %tab_elements; my $nb_elts;
my $no_elt = 0;
while(<Fher>) {
next if(not /(\d+)\s+ELEMENTS/o);
$nb_elts = $1;
last;
}
while(<Fher>) {
last if($no_elt == $nb_elts);
next if(not /^\s*\d+\s+\w+\s+\w+/o);
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(<Fher>) {
chomp;
if(/^\s*(N\S+)/o) {
$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/io or /^\s*elements/i or /^\s*[AFEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);

open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(A\S+)/o) {
$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/io or /^\s*elements/i or /^\s*[NFEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);

open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(F\S+)/) {
$nom_liste = $1;
$is_liste_en_cours = 1;
s/^\s*F\S+\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
elsif(/^\s*noeuds/io or /^\s*elements/i or /^\s*[NAEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);

open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(E\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NAFG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
}
close(Fher);

open(Fher, "<$fher");
$is_liste_en_cours = 0;
while(<Fher>) {
chomp;
if(/^\s*(G\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NAFE]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
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(<Flis>) {
chomp;
if(/^\s*(N\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[AFEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
s/^\s+//; s/\s+$//;
push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);

open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(A\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NFEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);

open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(F\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NAEG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);

open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(E\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NAFG]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
s/^\s+//; s/\s+$//;
push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
}
}
close(Flis);

open(Flis, "<$flis");
$is_liste_en_cours = 0;
while(<Flis>) {
chomp;
if(/^\s*(G\S+)/o) {
$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/io or /^\s*elements/io or /^\s*[NAFE]/o) {
$is_liste_en_cours = 0;
}
elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
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





#cette subroutine est associee a l option -disable_F. Le but est de scruter le fichier .msh et de supprimer les
# listes de face et les elements en lien avec ces listes de reference de faces
# **rq 1 : cette sub utilise la variable globale $fGmsh
# **rq 2 : cette sub modifie definitivement le fichier $fGmsh
#
sub suppr_liste_faces {
my $nb_elts;#nombre d elements original qui sera modifie en fonction du nombre d elements a supprimer

#saisie du nombre d elements original
my @liste_elts_a_supprimer;
open(my $Hlocal, "<$fGmsh");
while(<$Hlocal>) {
if(not defined $nb_elts and /^\s*\$Elements/io) {
$_ = <$Hlocal>;
($nb_elts) = $_ =~ /(\d+)/;
last;
}
}

#constitution d une table d indicateur de suppression d un element (par defaut : pas de suppression, donc => $elt_a_supprimer[no elt] = 0
my @elt_a_supprimer; for(1 .. $nb_elts) {$elt_a_supprimer[$_] = 0;}
MAIN_WHILE:while(<$Hlocal>) {
next if(not /^\s*\$ElementData\s*$/io);

#par cette boucle, on ne va traiter que les listes de faces (reperees par une ligne commencant par "F)
# pour les autres types de ref, on recommencera un nouveau tour de MAIN_WHILE
while(<$Hlocal>) {
next MAIN_WHILE if(/^\s*\$EndElementData\s*$/io);
last if(/^\s*\"\s*F\S+/o);#on passe a la boucle suivante si c est une liste de face
}

#on traite la liste de faces : les elements de cet ElementData seront a supprimer (on l indique en mettant 1 dans la table d indicateur)
while(<$Hlocal>) {
last if(/^\s*\$EndElementData\s*$/io);
next if(not /^\s*(\d+)\s+\d+\s*$/o);
$elt_a_supprimer[$1] = 1;#on indique que c est un element a supprimer
}
}
close($Hlocal);

#constitution d une table de correspondance entre ancien numero et nouveau numero d elements
#et du nouveau nombre d element
my @tab_corresp_elt_old_new;
my $nb_elts_new = 0;
for(my $i=1; $i<=$nb_elts; $i++) {
next if($elt_a_supprimer[$i]);#on passe si l element est a supprimer

#element a conserver => on incremente le nouveau nombre d elements et on fait la correspondance entre l ancien numero ($i) et le nouveau ($nb_elts_new)
$nb_elts_new++;
$tab_corresp_elt_old_new[$i] = $nb_elts_new;#nouveau numero pour cet element
}

#desormais, on a toutes les infos pour reecrire le fichier $fGmsh en supprimant les references de faces et en renumerotant
# les elements en fonction de @tab_corresp_elt_old_new
open($Hlocal, "<$fGmsh");
open(my $Htmp, ">$fGmsh.tmp");

#traitement de la liste des elements
while(<$Hlocal>) {
print $Htmp $_;
next if(not /^\s*\$Elements/io);
<$Hlocal>;
print $Htmp "$nb_elts_new\n";
while(<$Hlocal>) {
if(/^\s*\$EndElements\s*$/io) {
print $Htmp $_;
last;
}

next if(not /^\s*(\d+)/o);
my $no_elt = $1;
next if(not defined $tab_corresp_elt_old_new[$no_elt]);#rq : les elements a supprimer n ont pas de correspondance
s/^(\s*)$no_elt/$1$tab_corresp_elt_old_new[$no_elt]/;
print $Htmp $_;
}
last;
}

#traitement des ElementData
while(my $ligne = <$Hlocal>) {

#cas d un ElementData
if($ligne =~ /^\s*\$ElementData\s*$/io) {
my $entete = $ligne;
#on lit jusqu au nom de la reference
while($ligne = <$Hlocal>) {
$entete .= $ligne;
last if($ligne =~ /^\s*\"/o);
}

#pas de recopie si c est une reference de faces
if($ligne =~ /^\s*\"\s*F\S+/o) {
while($ligne = <$Hlocal>) {
last if($ligne =~ /^\s*\$EndElementData\s*$/io);
}
}
#si c est autre chose qu une reference de face, on modifie les numeros d elements en fonction de la table de correspondance
else {
print $Htmp $entete;
while($ligne = <$Hlocal>) {
if($ligne =~ /^\s*(\d+)\s+\d+\s*$/o) {
my $no_elt = $1;
$ligne =~ s/^(\s*)\d+/$1$tab_corresp_elt_old_new[$no_elt]/;
}
print $Htmp $ligne;
last if($ligne =~ /^\s*\$EndElementData\s*$/io);
}
}

}

#autre chose qu un ElementData
else {
print $Htmp $ligne;
}
}
close($Htmp);
close($Hlocal);

system("mv -f $fGmsh.tmp $fGmsh");
}#sub suppr_liste_faces
(10-10/24)
Redmine Appliance - Powered by TurnKey Linux