pre-pos_processing_gmsh-herezh

#!/usr/bin/env perl

use strict;

use warnings;

use English;

use File::Basename;

my $NOM_PROG = basename $PROGRAM_NAME;

my $VERSION = '1.00';

#####################################################################################################

#  script pour visualiser un ou plusieurs maillages dans Gmsh                                       #

#  version 1.00 : version initiale                                                                  #

#####################################################################################################

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 wrap("", "      ", "But : permet de scinder un maillage en 2 selon une reference d elements\n");

  print "\n";

  print "Usage :\n";

  print wrap("    ","        $indent_NOM_PROG ", "> $NOM_PROG [-h|help] fher_ini nom_liste\n");

  print "\n";

  print "Arguments :\n";

  print "    o fher_ini  : fichier maillage initial (.her)\n";

  print "    o nom_liste : nom de la liste des elements\n";

  print wrap("                  ", "                   ", "(si cet argument est un unique entier, alors le maillage sera scinde selon ce numero d element)\n");

  print "\n";

  print "Fonctionnement :\n";

  print wrap("      ", "    ", "$NOM_PROG cree 2 nouveaux maillages (sans ecraser le maillage initial fher_ini). Le premier maillage, ",

                             "de nom fher_ini suivi du suffixe _SetElts, contiendra uniquement les elements de la liste de reference nom_liste. ",

                             "Le deuxieme maillage, de nom fher_ini suivi du suffixe _AutresElts, contiendra tous les elements sauf ceux de la liste de reference.\n");

  print "\n";

  print wrap("      ", "    ", "Les listes de reference du maillage initial seront reportees vers les 2 nouveaux maillages avec les modifications qui s imposent (nouvelle numerotation noeuds/elements, suppression des noeuds/elements non presents, suppression des eventuelles references devenues vides)\n");

  print "\n";

  print "Options :\n";

  print wrap("    ", "                   ", "-lis fic.lis : ajout d un fichier de listes de reference supplementaires (peut etre repetee autant de fois que necessaire)\n");

  print "\n";

  print "Exemples :\n";

  print wrap("    ", "      ", "o scinder le maillage mail1.her selon le set d elements E_elts1D\n");

  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG mail1.her E_elts1D\n");

  print wrap("    ", "      ", "o scinder le maillage mail1.her selon le set d elements E_tmp dont la definition est dans le fichier mon_fichier_tmp.txt\n");

  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -lis mon_fichier_tmp.txt mail1.her E_tmp\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";

  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_lis_sup = ();#option(s) -lis : ajout de fichiers de listes de reference supplementaires

my @args;

my $opt;

while($#ARGV > -1) {

  $opt = shift(@ARGV);

  #option -lis

  if($opt eq '-lis') {

    ($#ARGV > -1) or die "\nErreur (prog:$NOM_PROG,opt:-lis) : pas assez d arguments pour cette option...\n\n";

    my $flis_sup = shift(@ARGV);

    (-e $flis_sup) or die "\nErreur (prog:$NOM_PROG,opt:-lis) : fichier $flis_sup introuvable...\n\n";

    push(@liste_lis_sup, $flis_sup);

  }

  else {

    push(@args, $opt);

  }

}

($#args >= 1) or die "\nErreur (prog:$NOM_PROG) : pas assez d arguments...\n\n";

my $fher_ini = shift(@args); (-e $fher_ini) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_ini introuvable...\n\n";

my $liste_elts = shift(@args);

#nouveau maillage 1 (de suffixe _SetElts) => maillage contenant uniquement les elements du set $liste_elts

# rq : on ne prend que le basename de $fher_ini (le nouveau maillage sera donc cree dans le repertoire courant)

(my $fher_1 = basename $fher_ini) =~ s/.her$/_SetElts.her/;

#nouveau maillage 2 (de suffixe _AutresElts) => maillage contenant tous les elements SAUF ceux du set $liste_elts

# rq : on ne prend que le basename de $fher_ini (le nouveau maillage sera donc cree dans le repertoire courant)

(my $fher_2 = basename $fher_ini) =~ s/.her$/_AutresElts.her/;

#lecture du maillage initial

my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds,

    $nb_elts, $ref_tab_elts, @ref_listes) = lecture_mail_her($fher_ini);

#ajout des listes de reference supplementaires (option -lis)

foreach my $fic_lis (@liste_lis_sup) {

  add_listes_ref(\@ref_listes, $fic_lis);

}

($liste_elts =~ /^\d+$/ or defined($ref_listes[3]->{$liste_elts}[0])) or die "\nErreur (prog:$NOM_PROG) : liste d elements $liste_elts introuvable...\n\n";

#tableau indicateur de l appartenance des elements (=1 si appartient a la liste $liste_elts donc maillage 1 $fher_1, sinon =2 donc maillage 2 $fher_2)

my @tab_elts_appartenance_maillage; for(my $i=1; $i<=$nb_elts; $i++) {$tab_elts_appartenance_maillage[$i] = 2;}

#-cas d un unique entier

if($liste_elts =~ /^\d+$/) {

  $tab_elts_appartenance_maillage[$liste_elts] = 1;

}

#-cas d une liste d elements

else {

  foreach my $elt (@{$ref_listes[3]->{$liste_elts}}) {

    $tab_elts_appartenance_maillage[$elt] = 1;

  }

}

#liste des elements du set $liste_elts

my @liste_elts_fher_1;

#-cas d un unique entier

if($liste_elts =~ /^\d+$/) {

  push(@liste_elts_fher_1, $liste_elts);

}

#-cas d une liste d elements

else {

  foreach my $elt (@{$ref_listes[3]->{$liste_elts}}) {push(@liste_elts_fher_1, $elt);}

}

#liste des elements qui ne sont pas contenus dans le set $liste_elts

my @liste_elts_fher_2;

for(my $i=1; $i<=$nb_elts; $i++) {

  next if($tab_elts_appartenance_maillage[$i] == 1);

  push(@liste_elts_fher_2, $i);

}

#verif : il faut que le nombre d elements de @liste_elts_fher_1 + @liste_elts_fher_2 == $nb_elts (sinon ca veut dire qu il manque des elements ou que certains elements sont a la fois dans la liste 1 et 2)

$_ = $#liste_elts_fher_1 + 1 + $#liste_elts_fher_2 + 1;

($_ == $nb_elts) or die "\nErreur (prog:$NOM_PROG) : le nombre d elements des deux listes n est pas egal au nombre total d elements ($_ elts dans les listes contre $nb_elts en tout)...\n\n";

#------------------------------------------------------

#

#table des noeuds et des elements du maillage 1

#

#------------------------------------------------------

my ($nb_noeuds_1, $nb_elts_1, $ref_tab_noeuds_1, $ref_tab_elts_1);

$nb_noeuds_1 = $nb_elts_1 = 0;

#-table de correspondance entre ancien noeud et nouveau noeud + ancien elt et nouvel element

my @tab_corresp_noeud_old_new; for(my $i=1; $i<=$nb_noeuds; $i++) {$tab_corresp_noeud_old_new[$i] = 0;}

my @tab_corresp_elt_old_new; for(my $i=1; $i<=$nb_elts; $i++) {$tab_corresp_elt_old_new[$i] = 0;}

for(my $i=1; $i<=$nb_elts; $i++) {

  next if($tab_elts_appartenance_maillage[$i] != 1);

  $nb_elts_1++;

  $ref_tab_elts_1->{$nb_elts_1}{'TYPE'} = $ref_tab_elts->{$i}{'TYPE'};

  $tab_corresp_elt_old_new[$i] = $nb_elts_1;

  foreach my $noeud (@{$ref_tab_elts->{$i}{'CONNEX'}}) {

    if($tab_corresp_noeud_old_new[$noeud] == 0) {

      $nb_noeuds_1++;

      $ref_tab_noeuds_1->[$nb_noeuds_1][0] = $ref_tab_noeuds->[$noeud][0];

      $ref_tab_noeuds_1->[$nb_noeuds_1][1] = $ref_tab_noeuds->[$noeud][1];

      $ref_tab_noeuds_1->[$nb_noeuds_1][2] = $ref_tab_noeuds->[$noeud][2];

      $tab_corresp_noeud_old_new[$noeud] = $nb_noeuds_1;

    }

    push(@{$ref_tab_elts_1->{$nb_elts_1}{'CONNEX'}}, $tab_corresp_noeud_old_new[$noeud]);

  }

}

#------------------------------------------------------

#

#ecriture du maillage 1 $fher_1

#

#------------------------------------------------------

$fher_1 .= '.her' if(not $fher_1 =~ /\.her$/);

my $flis_1 = $fher_1; $flis_1 =~ s/.her$/.lis/;

$nom_maillage = basename $fher_1; $nom_maillage =~ s/\.her$//;

open(FIC, ">$fher_1");

#cas d un unique entier

if($liste_elts =~ /^\d+$/) {

  print FIC "\#($NOM_PROG) => maillage issu du maillage $fher_ini : element $liste_elts\n";

}

#cas d une liste d elements

else {

 print FIC "\#($NOM_PROG) => maillage issu du maillage $fher_ini : elements de la liste $liste_elts\n";

}

print FIC "\n";

print FIC " nom_maillage $nom_maillage\n";

print FIC "\n";

print FIC " noeuds\n";

print FIC " $nb_noeuds_1 NOEUDS\n";

print FIC "\n";

for(my $i=1; $i<=$nb_noeuds_1; $i++) {print FIC " $i @{$ref_tab_noeuds_1->[$i]}\n";}

print FIC "\n";

print FIC " elements\n";

print FIC " $nb_elts_1 ELEMENTS\n";

print FIC "\n";

for(my $i=1; $i<=$nb_elts_1; $i++) {print FIC " $i  $ref_tab_elts_1->{$i}{'TYPE'}  @{$ref_tab_elts_1->{$i}{'CONNEX'}}\n";}

close(FIC);

my $Hlis = *HLIS;

my $is_liste = 0;#indicateur pour signaler si il y a au moins une liste de reference (et donc creation d un .lis)

my @liste_tmp;

#liste de noeuds

foreach my $nom_ref (keys %{$ref_listes[0]}) {

  @liste_tmp = ();

  foreach my $noeud (@{$ref_listes[0]->{$nom_ref}}) {

    next if(not $tab_corresp_noeud_old_new[$noeud]);

    push(@liste_tmp, $tab_corresp_noeud_old_new[$noeud]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_1");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions de noeuds

  print $Hlis "\n";

  ecrire_liste_N_E($Hlis, $nom_ref, @liste_tmp);

}

#liste d aretes

foreach my $nom_ref (keys %{$ref_listes[1]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[1]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[1]->{$nom_ref}[$i];

    $_[1] = $ref_listes[1]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_1");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

#liste de faces

foreach my $nom_ref (keys %{$ref_listes[2]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[2]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[2]->{$nom_ref}[$i];

    $_[1] = $ref_listes[2]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_1");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

#liste d elements

foreach my $nom_ref (keys %{$ref_listes[3]}) {

  @liste_tmp = ();

  foreach my $elt (@{$ref_listes[3]->{$nom_ref}}) {

    next if(not $tab_corresp_elt_old_new[$elt]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$elt]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_1");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_N_E($Hlis, $nom_ref, @liste_tmp);

}

#liste de points d integration

foreach my $nom_ref (keys %{$ref_listes[4]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[4]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[4]->{$nom_ref}[$i];

    $_[1] = $ref_listes[4]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_1");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

close($Hlis) if($is_liste);

if($is_liste) {

  #cas d un unique entier

  if($liste_elts =~ /^\d+$/) {

    print "\nLes fichiers $fher_1 et $flis_1 ont ete crees (element $liste_elts)...\n";

  }

  #cas d une liste d elements

  else {

    print "\nLes fichiers $fher_1 et $flis_1 ont ete crees (set d element : $liste_elts)...\n";

  }

}

else {

  #cas d un unique entier

  if($liste_elts =~ /^\d+$/) {

    print "\nLe fichier $fher_1 a ete cree (element $liste_elts)...\n";

  }

  #cas d une liste d elements

  else {

    print "\nLe fichier $fher_1 a ete cree (set d element : $liste_elts)...\n";

  }

}

#------------------------------------------------------

#

#table des noeuds et des elements du maillage 2

#

#------------------------------------------------------

my ($nb_noeuds_2, $nb_elts_2, $ref_tab_noeuds_2, $ref_tab_elts_2);

$nb_noeuds_2 = $nb_elts_2 = 0;

#-table de correspondance entre ancien noeud et nouveau noeud + ancien elt et nouvel element

for(my $i=1; $i<=$nb_noeuds; $i++) {$tab_corresp_noeud_old_new[$i] = 0;}

for(my $i=1; $i<=$nb_elts; $i++) {$tab_corresp_elt_old_new[$i] = 0;}

for(my $i=1; $i<=$nb_elts; $i++) {

  next if($tab_elts_appartenance_maillage[$i] != 2);

  $nb_elts_2++;

  $ref_tab_elts_2->{$nb_elts_2}{'TYPE'} = $ref_tab_elts->{$i}{'TYPE'};

  $tab_corresp_elt_old_new[$i] = $nb_elts_2;

  foreach my $noeud (@{$ref_tab_elts->{$i}{'CONNEX'}}) {

    if($tab_corresp_noeud_old_new[$noeud] == 0) {

      $nb_noeuds_2++;

      $ref_tab_noeuds_2->[$nb_noeuds_2][0] = $ref_tab_noeuds->[$noeud][0];

      $ref_tab_noeuds_2->[$nb_noeuds_2][1] = $ref_tab_noeuds->[$noeud][1];

      $ref_tab_noeuds_2->[$nb_noeuds_2][2] = $ref_tab_noeuds->[$noeud][2];

      $tab_corresp_noeud_old_new[$noeud] = $nb_noeuds_2;

    }

    push(@{$ref_tab_elts_2->{$nb_elts_2}{'CONNEX'}}, $tab_corresp_noeud_old_new[$noeud]);

  }

}

#------------------------------------------------------

#

#ecriture du maillage 2 $fher_2

#

#------------------------------------------------------

$fher_2 .= '.her' if(not $fher_2 =~ /\.her$/);

my $flis_2 = $fher_2; $flis_2 =~ s/.her$/.lis/;

$nom_maillage = basename $fher_2; $nom_maillage =~ s/\.her$//;

open(FIC, ">$fher_2");

#cas d un unique entier

if($liste_elts =~ /^\d+$/) {

  print FIC "\#($NOM_PROG) => maillage issu du maillage $fher_ini : tous les elements sauf element $liste_elts\n";

}

#cas d une liste d elements

else {

  print FIC "\#($NOM_PROG) => maillage issu du maillage $fher_ini : tous les elements sauf ceux de la liste $liste_elts\n";

}

print FIC "\n";

print FIC " nom_maillage $nom_maillage\n";

print FIC "\n";

print FIC " noeuds\n";

print FIC " $nb_noeuds_2 NOEUDS\n";

print FIC "\n";

for(my $i=1; $i<=$nb_noeuds_2; $i++) {print FIC " $i @{$ref_tab_noeuds_2->[$i]}\n";}

print FIC "\n";

print FIC " elements\n";

print FIC " $nb_elts_2 ELEMENTS\n";

print FIC "\n";

for(my $i=1; $i<=$nb_elts_2; $i++) {print FIC " $i  $ref_tab_elts_2->{$i}{'TYPE'}  @{$ref_tab_elts_2->{$i}{'CONNEX'}}\n";}

close(FIC);

$Hlis = *HLIS;

$is_liste = 0;#indicateur pour signaler si il y a au moins une liste de reference (et donc creation d un .lis)

#liste de noeuds

foreach my $nom_ref (keys %{$ref_listes[0]}) {

  @liste_tmp = ();

  foreach my $noeud (@{$ref_listes[0]->{$nom_ref}}) {

    next if(not $tab_corresp_noeud_old_new[$noeud]);

    push(@liste_tmp, $tab_corresp_noeud_old_new[$noeud]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_2");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions de noeuds

  print $Hlis "\n";

  ecrire_liste_N_E($Hlis, $nom_ref, @liste_tmp);

}

#liste d aretes

foreach my $nom_ref (keys %{$ref_listes[1]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[1]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[1]->{$nom_ref}[$i];

    $_[1] = $ref_listes[1]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_2");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

#liste de faces

foreach my $nom_ref (keys %{$ref_listes[2]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[2]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[2]->{$nom_ref}[$i];

    $_[1] = $ref_listes[2]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_2");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

#liste d elements

foreach my $nom_ref (keys %{$ref_listes[3]}) {

  @liste_tmp = ();

  foreach my $elt (@{$ref_listes[3]->{$nom_ref}}) {

    next if(not $tab_corresp_elt_old_new[$elt]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$elt]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_2");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_N_E($Hlis, $nom_ref, @liste_tmp);

}

#liste de points d integration

foreach my $nom_ref (keys %{$ref_listes[4]}) {

  @liste_tmp = ();

  for(my $i=0; $i<$#{$ref_listes[4]->{$nom_ref}}; $i+=2) {

    $_[0] = $ref_listes[4]->{$nom_ref}[$i];

    $_[1] = $ref_listes[4]->{$nom_ref}[$i+1];

    next if(not $tab_corresp_elt_old_new[$_[0]]);

    push(@liste_tmp, $tab_corresp_elt_old_new[$_[0]], $_[1]);

    if($is_liste == 0) {

      $is_liste = 1;

      open($Hlis, ">$flis_2");

    }

  }

  next if($#liste_tmp == -1);#pas d ecriture si la liste est devenue vide suite a des suppressions d elements

  print $Hlis "\n";

  ecrire_liste_A_F($Hlis, $nom_ref, @liste_tmp);

}

close($Hlis) if($is_liste);

if($is_liste) {

  print "Les fichiers $fher_2 et $flis_2 ont ete crees...\n\n";

}

else {

  print "Le fichier $fher_2 a ete cree...\n\n";

}

#sub pour ajouter des listes de reference issu d un fichier fourni par option -lis

sub add_listes_ref {

  my $ref_listes = shift;#reference vers la liste des references fournies par lecture_mail_her

  my $flis = shift;#fichier .lis

  #lecture des listes de reference du fichier $flis

  my @ref_listes_tmp = lire_ref($flis);

  #ajout de ces listes dans la reference d entree

  #rappel : $i == 0 => NOEUDS

  #rappel : $i == 1 => ARETES

  #rappel : $i == 2 => FACES

  #rappel : $i == 3 => ELEMENTS

  #rappel : $i == 4 => POINTS D INTEGRATION

  for(my $i=0; $i<=4; $i++) {

    foreach my $nom (keys(%{$ref_listes_tmp[$i]})) {

      @{$ref_listes->[$i]{$nom}} = @{$ref_listes_tmp[$i]->{$nom}};

    }

  }

}

#sub pour lire les refs dans un fichier et creer la variable @ref_listes qui a la meme structure

#  que celle en sortie de lecture_mail_her

#           => $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 lire_ref {

  my $fic = shift;#.lis ou .her

  my @ref_listes;

  my ($is_liste_en_cours, $nom_liste);

  #NOEUDS

  open(my $Hlocal, "<$fic");

  $is_liste_en_cours = 0;

  while(<$Hlocal>) {

    chomp;

    if(/^\s*(N\S+)/) {

      $nom_liste = $1;

      $is_liste_en_cours = 1;

      s/^\s*N\S+\s+//; s/\s+$//;

      push(@{$ref_listes[0]->{$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(@{$ref_listes[0]->{$nom_liste}},split(/\s+/,$_));

    }

  }

  close($Hlocal);

  #ARETES

  open($Hlocal, "<$fic");

  $is_liste_en_cours = 0;

  while(<$Hlocal>) {

    chomp;

    if(/^\s*(A\S+)/) {

      $nom_liste = $1;

      $is_liste_en_cours = 1;

      s/^\s*A\S+\s+//; s/\s+$//;

      push(@{$ref_listes[1]->{$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(@{$ref_listes[1]->{$nom_liste}},split(/\s+/,$_));

    }

  }

  close($Hlocal);

  #FACES

  open($Hlocal, "<$fic");

  $is_liste_en_cours = 0;

  while(<$Hlocal>) {

    chomp;

    if(/^\s*(F\S+)/) {

      $nom_liste = $1;

      $is_liste_en_cours = 1;

      s/^\s*F\S+\s+//; s/\s+$//;

      push(@{$ref_listes[2]->{$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(@{$ref_listes[2]->{$nom_liste}},split(/\s+/,$_));

    }

  }

  close($Hlocal);

  #ELEMENTS

  open($Hlocal, "<$fic");

  $is_liste_en_cours = 0;

  while(<$Hlocal>) {

    chomp;

    if(/^\s*(E\S+)/) {

      $nom_liste = $1;

      $is_liste_en_cours = 1;

      s/^\s*E\S+\s+//; s/\s+$//;

      push(@{$ref_listes[3]->{$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(@{$ref_listes[3]->{$nom_liste}},split(/\s+/,$_));

    }

  }

  close($Hlocal);

  #POINTS D INTEGRATION

  open($Hlocal, "<$fic");

  $is_liste_en_cours = 0;

  while(<$Hlocal>) {

    chomp;

    if(/^\s*(G\S+)/) {

      $nom_liste = $1;

      $is_liste_en_cours = 1;

      s/^\s*G\S+\s+//; s/\s+$//;

      push(@{$ref_listes[4]->{$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(@{$ref_listes[4]->{$nom_liste}},split(/\s+/,$_));

    }

  }

  ##AFFICHAGE DES LISTES DE NOEUDS

  #foreach my $nom (keys(%{$ref_listes[0]})) {

  #  print "$nom : @{$ref_listes[0]->{$nom}}\n";

  #}

  #<STDIN>;

  ##AFFICHAGE DES LISTES D ARETES

  #foreach my $nom (keys(%{$ref_listes[1]})) {

  #  print "$nom : @{$ref_listes[1]->{$nom}}\n";

  #}

  #<STDIN>;

  ##AFFICHAGE DES LISTES DE FACES

  #foreach my $nom (keys(%{$ref_listes[2]})) {

  #  print "$nom : @{$ref_listes[2]->{$nom}}\n";

  #}

  #<STDIN>;

  ##AFFICHAGE DES LISTES D ELEMENTS

  #foreach my $nom (keys(%{$ref_listes[3]})) {

  #  print "$nom : @{$ref_listes[3]->{$nom}}\n";

  #}

  #<STDIN>;

  ##AFFICHAGE DES LISTES DE POINTS D INTEGRATION

  #foreach my $nom (keys(%{$ref_listes[4]})) {

  #  print "$nom : @{$ref_listes[4]->{$nom}}\n";

  #}

  #<STDIN>;

  return @ref_listes;

}

#sub pour ecrire une liste de noeuds et elements

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

#sub pour ecrire une liste d aretes et faces

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 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+)/) {$nom_maillage = $1; next;}

    next if(not /(\d+)\s+NOEUDS/);

    $nb_noeuds = $1;

    last;

  }

  while(<Fher>) {

    last if($no_noeud == $nb_noeuds);

    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);

    $no_noeud = $1;

    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);