#!/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);
  }

  #-lecture des elements
  my %tab_elements; my $nb_elts;
  my $no_elt = 0;
  while(<Fher>) {
    next if(not /(\d+)\s+ELEMENTS/);
    $nb_elts = $1;
    last;
  }
  while(<Fher>) {
    last if($no_elt == $nb_elts);
    next if(not /^\s*\d+\s+\w+\s+\w+/);
    s/^\s+//;s/\s+$//;
    $_ =~ /^(\d+)\s+/;
    $no_elt = $1; s/^(\d+)\s+//;
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
  }
  close(Fher);


  #------------------------
  # lecture des references (dans le .her et dans un eventuel .lis)
  #------------------------
  my $flis = $fher; $flis =~ s/.her$/.lis/;
  my $nom_liste;
  my $is_liste_en_cours;
  my %listes_NOEUDS;
  my %listes_ARETES;
  my %listes_FACES;
  my %listes_ELEMENTS;
  my %listes_PTI;

  #-dans le .her
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Fher>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Fher>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Fher>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Fher>) {
    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(<Flis>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Flis>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Flis>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Flis>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[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(<Flis>) {
    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
