Projet

Général

Profil

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

version 1.025 (ajout option -disable_F : desactiver les listes de reference de faces) - Julien Troufflard, 03/03/2017 09:32

 
1
#!/usr/bin/env perl
2
use strict;
3
use warnings;
4
use English;
5
use File::Spec::Functions qw(rel2abs);
6
use File::Basename;
7
my $NOM_PROG = basename $PROGRAM_NAME;
8

    
9

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

    
46

    
47

    
48

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

    
61

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

    
71
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
72
# FIN VARIABLES UTILISATEUR                                 #
73
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
74

    
75

    
76

    
77

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

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

    
86
  print "----------------------------------------\n";
87
  print " script $NOM_PROG  (version $VERSION)\n";
88
  print "----------------------------------------\n";
89
  print "\n";
90
  print "But : visualiser des maillages Herezh avec Gmsh\n";
91
  print "\n";
92
  print "Usage 1 : mode interactif\n";
93
  print "          > $NOM_PROG\n";
94
  print "Usage 2 : lancement avec arguments\n";
95
  print wrap("          ","            $indent_NOM_PROG ", "> $NOM_PROG [-h|help] [-v] [-exeHZ path_HZ] [-exeGMSH path_GMSH] [-saveVisu] fher_1 [fher_2 .. fher_N]\n");
96
  print "\n";
97
  print "Arguments :\n";
98
  print "     o fic_1   : 1er maillage .her\n";
99
  print "     o [fher_2 .. fher_N] : maillages .her supplementaires eventuels\n";
100
  print "\n";
101
  print "Fonctionnement :\n";
102
  print wrap("      ", "    ", "$NOM_PROG lance un calcul herezh pour creer un fichier .msh ",
103
                               "qui est ensuite visualise dans Gmsh. La visualisation des references est ",
104
                               "desactivee a l ouverture (exceptee la derniere vue qui est specialement ",
105
                               "creee par ce script pour afficher les elements en vue solide) ",
106
                               "Le code couleur pour les references est :\n");
107
  print wrap("          ", "          ", "- reference de noeuds   => rouge\n",
108
                                      "- reference d  aretes   => jaune\n",
109
                                      "- reference de faces    => vert\n",
110
                                      "- reference d  elements => bleu\n");
111
                                      "- reference de points d integration => mauve\n";
112
  print wrap("      ", "    ", "Dans le cas de maillages avec beaucoup d elements, la preparation des fichiers ", 
113
  "peut prendre du temps. Il est alors conseille d utiliser l option -saveVisu pour ",
114
  "conserver les fichiers de visualisation pour pouvoir les reouvrir ulterieurment ",
115
  "sans avoir a reexecuter ce script.\n");
116
  print "\n";
117
  print "Options :\n";
118
  print "    -v : affichage du numero de version\n";
119
  print "\n";
120
  print wrap("    ", "                     ", "-exeHZ path_HZ : choisir l executable Herezh++. Le calcul Herezh se ",
121
                                                               "fera avec l executable path_HZ\n",
122
                                                               "par defaut : linux 64 bits   => path_HZ=HZppfast64\n", 
123
                                                               "             MacOSX (darwin) => path_HZ=HZppfast_Vn-1\n",
124
                                                               "             autres          => path_HZ=HZppfast\n",
125
                                                               "(a noter que les alias shell ne fonctionneront pas)\n",
126
                                                               "(a noter que cette option fonctionne aussi en mode interactif)\n");
127
  print "\n";
128
  print wrap("    ", "                         ", "-exeGMSH path_GMSH : choisir l executable Gmsh. La visualisation Gmsh se ",
129
                                                                       "fera avec l executable path_GMSH\n",
130
                                                                       "par defaut : path_GMSH=gmsh\n",
131
                                                                       "(a noter que les alias shell ne fonctionneront pas)\n",
132
                                                                       "(a noter que cette option fonctionne aussi en mode interactif)\n");
133
  print "\n";
134
  print wrap("    ", "                 ", "-saveVisu : sauvegarde des fichiers .geo et .msh de visu\n");
135
  print "\n";
136
  print wrap("    ", "            ", "-quit : executer le script sans lancer la visualisation Gmsh\n");
137
  print "\n";
138
  print wrap("    ", "                     ", "-lis_i fic.lis : ajout de fichiers de listed de reference pour le maillage f_her_i ",
139
                                                               "(cette option peut etre repetee autant de fois que necessaire)\n",
140
                                                               "exemple : $NOM_PROG -lis_1 mon_fic.lis maillage.her\n");
141
  print "\n";
142
  print wrap("    ", "                  ", "-disable_F  : desactiver l affichage des listes de reference de faces\n");
143
  print "\n";
144
  print "Exemples :\n";
145
  print wrap("    ", "      ", "o visualiser les maillages mail1.her et mail2.her :\n");
146
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG mail1.her mail2.her\n");
147
  print wrap("    ", "      ", "o visualiser le maillage mail1.her en choisissant l executable Herezh :\n");
148
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -exeHZ HZpp_perso mail1.her\n");
149
  print wrap("    ", "      ", "o visualiser le maillage mail1.her et sauvegarder les fichiers de visu :\n");
150
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -saveVisu  mail1.her\n");
151
  print wrap("    ", "      ", "o visualiser le maillage mail1.her en choisissant l executable Herezh et ",
152
                                 "l executable Gmsh (exemple dans le cas ou les executables se trouvent ",
153
                                 "quelque part dans le HOME) :\n");
154
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -exeHZ ~/mon_rep_HZ/HZpp -exeGMSH ~/mon_rep_GMSH/gmsh  mail1.her\n");
155
  print wrap("    ", "      ", "o creer et sauvegarder les fichiers de visualisation sans lancer la visualisation :\n");
156
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -saveVisu -quit  mail1.her\n");
157
  print wrap("    ", "      ", "o visualiser 2 maillages en ajoutant 2 fichiers .lis supplementaires pour le 2eme maillage :\n");
158
  print wrap("        ", "          $indent_NOM_PROG ", "> $NOM_PROG -lis_2 ref_sup.lis -lis_2 autres_ref_sup.lis  mail1.her mail2.her\n");
159
  print "\n";
160
  print "Auteur :\n";
161
  print "   TROUFFLARD Julien\n";
162
  print "       julien.troufflard\@univ-ubs.fr\n";
163
  print "       julien.troufflard\@free.fr\n";
164
  print "----------------------------------------\n";
165
}
166

    
167

    
168

    
169
#------------------------------------
170
#option -h ou -help => affichage de l aide et arret
171
#------------------------------------
172
# rq : insensible a la casse
173
foreach my $arg (@ARGV) {
174
  if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
175
    affichage_aide();
176
    exit;
177
  }
178
}
179

    
180
#------------------------------------
181
#option -v => affichage de la version et arret
182
#------------------------------------
183
foreach my $arg (@ARGV) {
184
  if($arg eq '-v') {
185
    print "\n $NOM_PROG : version $VERSION\n\n";
186
    exit;
187
  }
188
}
189

    
190

    
191

    
192
#------------------------------------
193
#recuperation des arguments et options
194
#------------------------------------
195
my @liste_fher;#liste des maillages
196
my $is_opt_saveVisu = 0;#indicateur de l option -saveVisu (sauvegarde des fichiers .geo et _Gmsh.msh de visualisation)
197
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)
198
my %FLIS_i;#table des .lis supplementaires indiques par une ou plusieurs options -lis_i
199
           #  fonctionnement de la variable :
200
           #             $FLIS_i{no maillage}{'IS_LIS_SUP'} = 1 ou non defini (sert d indicateur pour savoir si il y a des .lis supplementaires)
201
           #             @{ $FLIC_i{no maillage}{'LISTE'} } = (liste des fichiers .lis supplementaires)
202
my $is_opt_disable_F = 0;#indicateur de l option -disable_F (desactiver l affichage des listes de reference de faces)
203

    
204

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

    
211
  #option -exeHZ
212
  if($opt eq '-exeHZ') {
213
    ($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-exeHZ) : pas assez d arguments donnes pour cette option...\n\n";
214
    $exeHZ = shift(@ARGV);
215
  }
216
  #option -exeGMSH
217
  elsif($opt eq '-exeGMSH') {
218
    ($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-exeGMSH) : pas assez d arguments donnes pour cette option...\n\n";
219
    $exeGMSH = shift(@ARGV);
220
  }
221
  #option -saveVisu
222
  elsif($opt eq '-saveVisu') {
223
    $is_opt_saveVisu = 1;
224
  }
225
  #option -quit
226
  elsif($opt eq '-quit') {
227
    $is_opt_quit = 1;
228
  }
229
  #option -lis_i
230
  elsif($opt =~ /^-lis_(\d+)$/) {
231
    my $no_maillage = $1;
232
    ($#ARGV >= 0) or die "\nErreur (prog:$NOM_PROG,opt:-lis_$no_maillage) : pas assez d arguments donnes pour cette option...\n\n";
233
    my $flis_sup = shift(@ARGV);
234
    (-e $flis_sup) or die "\nErreur (prog:$NOM_PROG,opt:-lis_$no_maillage) : fichier $flis_sup introuvable...\n\n";
235
    #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)
236
    $no_maillage--;
237
    #indicateur de presence d au moins 1 fichier .lis supplementaire pour le maillage n? $no_maillage
238
    $FLIS_i{$no_maillage}{'IS_LIS_SUP'} = 1;
239
    #ajout du fichier dans la liste
240
    push(@{ $FLIS_i{$no_maillage}{'LISTE'} }, $flis_sup);
241
  }
242
  #option -disable_F
243
  elsif($opt eq '-disable_F') {
244
    $is_opt_disable_F = 1;
245
  }
246

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

    
252
  #autres arguments
253
  else {
254
    push(@args,$opt);
255
  }
256
}#while($#ARGV != -1)
257

    
258

    
259
#---------------------
260
#verif de l executable Herezh
261
#---------------------
262
#si la variable $exeHZ n a pas ete renseigne au prealable => on selectionne l executable par defaut en fonction de la plateforme
263
if(not defined($exeHZ)) {
264
  #- - - - - -
265
  #type de plateforme
266
  #- - - - - -
267
  my $type_OS;
268
  #-avec uname
269
  if(verif_cmd('uname')) {
270
    $type_OS = qx(uname -a);
271
    chomp($type_OS);
272
  }
273
  #-sinon : warning (OS inconnue)
274
  else {warn "**Attention : impossible de saisir le type de systeme d exploitation avec uname -a ...\n";}
275

    
276
  #selection de l executable Herezh
277
  #-linux 64 bits
278
  if($type_OS =~ /linux/i and $type_OS =~ /x86_64/i) {$exeHZ = $EXE_HZ_Linux64bits;}
279
  #-MacOSX (darwin)
280
  elsif($type_OS =~ /darwin/i) {$exeHZ = $EXE_HZ_MacOSX;}
281
  #-tous les autres (y compris linux 32 bits)
282
  else{$exeHZ = $EXE_HZ_autres;}
283
}
284
#verif de l executable Herezh
285
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";
286

    
287
#---------------------
288
#verif de l executable Gmsh
289
#---------------------
290
#si la variable $exeGMSH n a pas ete renseigne au prealable => on selectionne l executable par defaut
291
$exeGMSH = $exeGMSH_defaut if(not defined($exeGMSH));
292
#verif de l executable Gmsh
293
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";
294

    
295

    
296

    
297

    
298

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

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

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

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

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

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

    
356

    
357

    
358
#---------------------
359
#verif des maillages (constitution de la liste des noms de maillage)
360
#---------------------
361
print "  verification des maillages...\n";
362
my @liste_nom_maillage;
363
#-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
364
if($#liste_fher == 0) {
365
  my $nom_maillage = '';
366
  open(FIC, "<$liste_fher[0]") or die "\n**Erreur (prog:$NOM_PROG) : impossible d ouvrir le fichier $liste_fher[0] ...\n\n";
367
  while(<FIC>) {
368
    last if(/^\s*noeuds/o);
369
    next if(not /^\s*nom_maillage\s+(\S+)/o);
370
    $nom_maillage = $1;
371
    last;
372
  }
373
  close(FIC);
374
  $nom_maillage = 'premier_maillage' if($nom_maillage eq '');
375
  push(@liste_nom_maillage, $nom_maillage);
376
}
377

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

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

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

    
404
    #cas d un maillage ayant le meme nom qu un ou plusieurs autres maillages
405
    my @liste_maillages_meme_nom = ();
406
    for(my $j=$i+1; $j<=$#liste_nom_maillage; $j++) {
407
      if($liste_nom_maillage[$i] eq $liste_nom_maillage[$j]) {
408
        $maillages_deja_traites[$j] = 1;
409
        push(@liste_maillages_meme_nom, $liste_fher[$j]);
410
      }
411
    }
412
    if($#liste_maillages_meme_nom > -1) {
413
      warn "**Erreur (prog:$NOM_PROG) : les maillages suivants ont le meme nom => $liste_fher[$i] @liste_maillages_meme_nom\n";
414
      $is_maillage_ok = 0;
415
    }
416
  }
417

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

    
422

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

    
432
#-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)
433
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)
434

    
435
#on boucle sur les maillages pour constituer les listes d elements par dimension de loi de comportement pour chaque maillage
436
# 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)
437
my $is_elt_1D = 0;#indicateur de la presence d au moins 1 element 1D
438
my $is_elt_2D = 0;#indicateur de la presence d au moins 1 element 2D
439
my $nb_elts_tot = 0;
440
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
441
  #saisie des elements
442
  my ($nb_elts, $ref_elements);
443
  ($_, $_, $_, $nb_elts, $ref_elements) = lecture_mail_her($liste_fher[$no_mail]);
444
  $nb_elts_tot += $nb_elts;
445
  my @ELEM_1D = ();
446
  my @ELEM_2D = ();
447
  my @ELEM_3D = ();
448
  ELEM:for(my $i=1; $i<=$nb_elts; $i++) {
449
    #verif si element AXI (=> loi LOI_RIEN3D )
450
    foreach my $suffixe (@SUFFIXE_AXI) {
451
      @_ = split(/\s+/, $ref_elements->{$i}{'TYPE'});
452
      if($_[0] =~ /$suffixe\s*$/) {
453
        push(@ELEM_3D, $i);
454
        next ELEM;
455
      }
456
    }
457
    #verif si element 1D (=> loi LOI_RIEN1D )
458
    foreach my $prefixe (@PREFIXE_1D) {
459
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
460
        push(@ELEM_1D, $i);
461
        $is_elt_1D = 1;
462
        next ELEM;
463
      }
464
    }
465
    #verif si element 2D (=> loi LOI_RIEN2D_C )
466
    foreach my $prefixe (@PREFIXE_2D) {
467
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
468
        push(@ELEM_2D, $i);
469
        $is_elt_2D = 1;
470
        next ELEM;
471
      }
472
    }
473
    #sinon, c est un element 3D (=> loi LOI_RIEN3D )
474
    push(@ELEM_3D, $i);
475
  }#FIN BOUCLE SUR LES ELEMENTS DU MAILLAGE indice $no_mail
476

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

    
482
}#FIN BOUCLE SUR LES MAILLAGES
483

    
484

    
485

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

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

    
509

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

    
515
#-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)
516
my $HZ_symbolic_link = 'HZppfast_'.$PID.'_hz_visuMail';
517
my $absolute_path_cmd = absolute_path_cmd($exeHZ);
518
#-creation du lien symbolique
519
system("ln -s $absolute_path_cmd $HZ_symbolic_link");
520
#-capture du signal ctrl+c
521
$SIG{INT} = sub {
522
  #kill des processus Herezh (on les repere grace au nom du lien symbolique $HZ_symbolic_link
523
  foreach my $processus (qx(ps -U $ENV{USER} -o pid,%cpu,command | grep $HZ_symbolic_link | grep -v grep)) {
524
    next if(not $processus =~ /^\s*(\d+)/);
525
    kill("TERM", $1);
526
  }
527

    
528
  #destruction des fichiers temporaires
529
  efface_fic_temporaires();
530

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

    
534

    
535

    
536

    
537
#---------------------
538
#ecriture du .info
539
#---------------------
540
open(FIC, ">$finfo");
541
print FIC "dimension 3\n\n";
542

    
543
print FIC "niveau_commentaire 1\n\n";
544

    
545
#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)
546
print FIC "TYPE_DE_CALCUL\ndynamique_explicite\n";
547

    
548
#ecriture des maillages et de references d elements speciales
549
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
550
  my $fher = $liste_fher[$no_mail];
551
  my $flis = $fher; $flis =~ s/.her$/.lis/;
552
  print FIC "\n< $fher\n";
553
  print FIC "< $flis\n" if(-e $flis);#inclusion du .lis si il existe
554
  #ajout de .lis supplementaire si l option -lis_i a ete utilisee
555
  if(defined $FLIS_i{$no_mail}{'IS_LIS_SUP'}) {
556
    print FIC "< $_\n" for @{ $FLIS_i{$no_mail}{'LISTE'} };
557
  }
558
  #set d elements speciaux en fonction de la dimension de la loi de comportement
559
  #  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)
560
  foreach my $dim ('1D', '2D', '3D') {
561
    next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
562
    ecrire_liste_N_E(*FIC, "E_tmp_visu_elem_$dim", @{$TAB_DIM_LOI{$no_mail}{$dim}});
563
  }
564
}
565

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

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

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

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

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

    
604
print FIC "\ncharges\n\n";
605
print FIC "blocages\n\n";
606

    
607
#controle => un seul increment
608
print FIC "controle\n";
609
print FIC "DELTAt 1.\n";
610
print FIC "TEMPSFIN 1.\n";
611
print FIC "SAUVEGARDE 0\n";
612
print FIC "MAXINCRE 1\n";
613

    
614
print FIC "\npara_pilotage_equi_global\n\n";
615

    
616
print FIC "para_syteme_lineaire\n\n";
617

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

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

    
622
print FIC "_fin_point_info_\n";
623
close(FIC);
624

    
625

    
626
#---------------------
627
#ecriture du .CVisu
628
#---------------------
629
open(FIC, ">$fCVisu");
630
print FIC "
631
debut_fichier_commande_visu
632

    
633
  debut_visualisation_Gmsh
634
    debut_maillage_initial
635
      actif 1
636
      pseudo-homothetie_sur_les_maillages_ 0
637
      visualisation_references_sur_les_maillages_ 1
638
    fin_maillage_initial
639

    
640
    debut_choix_maillage
641
      actif 0
642
      1";
643
for(my $i=1; $i<=$#liste_fher; $i++) {$_ = $i + 1; print FIC " $_";}
644
print FIC " fin_choix_maillage
645
  fin_visualisation_Gmsh
646

    
647
fin_fichier_commande_visu
648
";
649
close(FIC);
650

    
651

    
652

    
653
#---------------------
654
#lancement du calcul
655
#---------------------
656
#-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)
657
my $fredir = "$racine_fic_tmp.log";
658
print "  creation du fichier _Gmsh.msh (calcul Herezh en cours)...\n";
659
system("rm -f $fGmsh $fredir");
660
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
661
#-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})
662
my $pid_fils = fork();
663
#---------- processus fils
664
            if($pid_fils == 0) {
665
              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
666
              exit;
667
            }
668
#---------- fin du processus fils
669
#attente de la fin du processus fils par son pere
670
waitpid($pid_fils, 0);
671

    
672

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

    
688
  #destruction des fichiers temporaires
689
  efface_fic_temporaires();
690

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

    
695

    
696
#---------------------
697
#lecture du .msh et reecriture pour modifier les couleurs selon le type de reference (noeud, arete, face, element)
698
#  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
699
#---------------------
700

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

    
715
#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)
716
#  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
717
my %table_couleur_type_ref = ('pt_integr'=>5, 'noeud'=>4, 'arete'=>3, 'face'=>2, 'element'=>1);
718

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

    
722

    
723

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

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

    
736

    
737

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

    
747
  #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)
748
  if($ligne =~ /^\s*\$ElementData\s*$/io) {
749
    my $entete = $ligne;
750
    #on lit jusqu au nom de la reference
751
    while($ligne = <FIC>) {
752
      $entete .= $ligne;
753
      last if($ligne =~ /^\s*\"/o);
754
    }
755

    
756
    #selection de l isovaleur en fonction du type de reference
757
    #-ref de noeuds
758
    if($ligne =~ /^\s*\"\s*N(\S+)/o) {
759
      push(@liste_type_reference, 'noeud');
760
      $couleur_type_ref = $table_couleur_type_ref{'noeud'};
761
    }
762
    #-ref d aretes
763
    elsif($ligne =~ /^\s*\"\s*A(\S+)/o) {
764
      push(@liste_type_reference, 'arete');
765
      $couleur_type_ref = $table_couleur_type_ref{'arete'};
766
    }
767
    #-ref de faces
768
    elsif($ligne =~ /^\s*\"\s*F(\S+)/o) {
769
      push(@liste_type_reference, 'face');
770
      $couleur_type_ref = $table_couleur_type_ref{'face'};
771
    }
772
    #-ref d elements
773
    elsif($ligne =~ /^\s*\"\s*E(\S+)/o) {
774
      push(@liste_type_reference, 'element');
775
      $couleur_type_ref = $table_couleur_type_ref{'element'};
776
    }
777
    #-ref de points d integration
778
    elsif($ligne =~ /^\s*\"\s*G(\S+)/o) {
779
      push(@liste_type_reference, 'pt_integr');
780
      $couleur_type_ref = $table_couleur_type_ref{'pt_integr'};
781
    }
782

    
783
    #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
784
    if($ligne =~ /E_tmp_visu_elem_/o) {
785
      while($ligne = <FIC>) {last if($ligne =~ /^\s*\$EndElementData\s*$/io);}
786
      pop(@liste_type_reference);#suppression du dernier element de la liste
787
    }
788
    #si c est une reference reellement dans le maillage, on recopie l en-tete actuel et on recopie l element data avec l isovaleur
789
    else {
790
      $is_Element_data = 1;
791
      print Ftmp $entete;
792
      while($ligne = <FIC>) {
793
        $ligne = "$1 $couleur_type_ref\n" if ($ligne =~ /^\s*(\d+)\s+\d+\s*$/o);
794
        print Ftmp $ligne;
795
        last if($ligne =~ /^\s*\$EndElementData\s*$/io);
796
      }
797
    }
798
  }#if($ligne =~ /^\s*\$ElementData\s*$/io)
799

    
800
  #cas general : on recopie simplement la ligne courante
801
  else {
802
    print Ftmp $ligne;
803
  }
804
}
805
close(FIC);
806

    
807
#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)
808
#  rq : les elements 1D se retrouvent egalement dans cette ref
809
print Ftmp "\$ElementData
810
1
811
\"Activer/Desactiver vue elements 2D 3D\"
812
0
813
3
814
0
815
1
816
$nb_elts_tot\n";
817
for(my $i=1; $i<=$nb_elts_tot; $i++) {
818
  print Ftmp "$i 0\n";#isovaleur 0
819
}
820
print Ftmp "\$EndElementData\n";
821
close(Ftmp);
822
system("mv -f $ftmp $fGmsh");
823

    
824

    
825

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

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

    
839
#-options generales
840
print FIC '
841
Geometry.Light = 0;     //desactivation de la lumiere (geometrie)
842
Mesh.Light = 0;         //desactivation de la lumiere (maillage)
843
View.Light = 0;         //desactivation de la lumiere (vue)
844
Mesh.ColorCarousel = 0; //type de couleur (0=by element type, 1=by elementary entity, 2=by physical entity, 3=by partition)
845
Geometry.Points = 0;    //affichage des points (=0 desactiver, =1 activer)
846
Mesh.Points = 0;        //affichage des noeuds (=0 desactiver, =1 activer)
847
Mesh.Lines = 1;         //affichage des lignes (elements 1D) (=0 desactiver, =1 activer)
848
Mesh.SurfaceEdges = 1;  //affichage des aretes des elements 2D (=0 desactiver, =1 activer)
849
Mesh.SurfaceFaces = 0;  //affichage des faces des elements 2D (=0 desactiver, =1 activer)
850
Mesh.VolumeEdges = 1;   //affichage des aretes des elements 3D (=0 desactiver, =1 activer)
851
Mesh.VolumeFaces = 0;   //affichage des faces des elements 3D (=0 desactiver, =1 activer)
852
View.Visible = 0;       //desactivation de toutes les vues au demarrage
853
View.ShowScale = 0;     //desactivation de la vue de l echelle d isovaleur
854
View.RangeType = 2;     //type de bornes des isovaleurs (2=Custom)
855
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)
856
View.CustomMax = 5;     //borne maxi isovaleur
857
View.PointType = 1;     //type d affichage des points (1=3D sphere)
858
View.PointSize = 4.;    //taille des points
859
View.LineType = 1;      //type d affichage des lignes (1=3D cylinder)
860
View.LineWidth = 3.;    //taille des lignes
861

    
862
Mesh.PointSize = 3.;   //taille des noeuds
863
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
864
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
865
Mesh.Color.Triangles = {0,0,0};
866
Mesh.Color.Quadrangles = {0,0,0};
867
Mesh.Color.Tetrahedra = {0,0,0};
868
Mesh.Color.Hexahedra = {0,0,0};
869
Mesh.Color.Prisms = {0,0,0};
870
Mesh.Color.Pyramids = {0,0,0};
871
';
872

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

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

    
886
#on indique d afficher la vue speciale qui sert a afficher les faces des elements 2D 3D (la derniere qui a ete cree)
887
#  rq : pour cette vue, on remet l affichage classique pour les points et les lignes
888
print FIC "//options speciales pour la derniere vue qui sert a l affichage des faces des elements 2D et 3D\n";
889
$_ = $#liste_type_reference + 1;#cette vue n est pas enregistree dans la liste, son numero est donc egal a la derniere + 1
890
print FIC "View[$_].Visible = 1;\n";
891
print FIC "View[$_].PointType = 0;     //type d affichage des points (0=Color dot)\n";
892
print FIC "View[$_].PointSize = 3.;    //taille des points\n";
893
print FIC "View[$_].LineType = 0;		//type d affichage des lignes (0=Color segment)\n";
894
print FIC "View[$_].LineWidth = 1.; 	//taille des lignes\n";
895
print FIC "View[$_].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";
896

    
897
close(FIC);
898

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

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

    
915
#destruction des fichiers temporaires
916
efface_fic_temporaires();
917

    
918

    
919

    
920

    
921

    
922

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

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

    
941

    
942
#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 ??!!?!??!!!)
943
# N EST PLUS UTILISE DEPUIS LA VERSION 1.01 => A LA PLACE, ON UTILISE LA SUB verif_cmd()
944
##sub which_absolute {
945
##  use File::Which;
946
##  my $cmd = shift;
947
##  my @path;
948
##  #cas d une commande avec chemin absolu
949
##  if($cmd =~ /^\// and -x $cmd) {
950
##    @path = ($cmd);
951
##  }
952
##  #commande which classique
953
##  push(@path, which($cmd));
954
##  return(@path);
955
##}
956

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

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

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

    
969
  #cas ou la commande n existe pas
970
  return 0;
971
}
972

    
973
#cette subroutine renvoie le chemin absolu vers une commande (renvoie 0 si commande introuvable ou non executable)
974
#  strategie :
975
#     1- si la commande commence par "." ou "/" => on renvoie simplement son path absolu
976
#     2- ensuite, on donne la priorite aux commandes presentes dans $PATH
977
#      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 :
978
#                   alors si on passe la commande "toto.x" a cette subroutine, elle va renvoyer le path absolu vers le fichier present dans
979
#                   /Users/Dupont/bin. Ce qui force l utilisateur a presciser par un "./" si il veut la commande du repertoire courant "./toto.x"
980
sub absolute_path_cmd {
981
  my $cmd = shift;
982

    
983
  my $absolute_cmd = 0;
984

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

    
990
  #2-
991
    #2-a : d abord dans les $PATH
992
    foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
993
      if(-e "$path/$cmd") {
994
        $absolute_cmd = rel2abs("$path/$cmd");
995
        last;
996
      }
997
    }
998
    #2-b : ensuite dans les repertoires hors $PATH
999
    if(-e $cmd) {
1000
      $absolute_cmd = rel2abs($cmd);
1001
    }
1002

    
1003

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

    
1009
  return $absolute_cmd;
1010
}#sub absolute_path_cmd
1011

    
1012

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

    
1020
  my $cpt; my $cpt_max = 15; my $nb_blancs;
1021

    
1022
  $nb_blancs = ""; $nb_blancs .= " " for(1 .. length($nom_liste));
1023
  $_ = shift(@liste_no);
1024
  print $handle " $nom_liste $_";
1025
  $cpt = 1;
1026
  foreach my $no (@liste_no) {
1027
    $cpt++;
1028
    if($cpt == 1) {print $handle " $nb_blancs $no";}
1029
    elsif($cpt == $cpt_max) {print $handle " $no\n"; $cpt = 0;}
1030
    else {print $handle " $no";}
1031
  }
1032
  print $handle "\n" if($cpt != $cpt_max);
1033
}#sub ecrire_liste_noeuds
1034

    
1035

    
1036
#----------------
1037
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
1038
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
1039
#
1040
# exemple d appel :
1041
#  my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her");
1042
#
1043
#  avec - $nom_maillage     : nom du maillage (si il y en a un. sinon $nom_maillage sera egal a undef
1044
#       - $nb_noeuds        : nombre de noeuds (entier)
1045
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
1046
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
1047
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
1048
#       - $nb_elts          : nombre d elements (entier)
1049
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
1050
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
1051
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
1052
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
1053
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
1054
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
1055
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
1056
#                                $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)
1057
#                                
1058
sub lecture_mail_her {
1059
  my $fher = shift;
1060

    
1061
  my $nom_maillage;
1062

    
1063
  #------------------------
1064
  # lecture du maillage .her
1065
  #------------------------
1066
  #-lecture de noeuds
1067
  my @tab_noeuds; my $nb_noeuds;
1068
  my $no_noeud = 0;
1069
  open(Fher, "<$fher");
1070
  while(<Fher>) {
1071
    if(/^\s*nom_maillage\s+(\S+)/o) {$nom_maillage = $1; next;}
1072
    next if(not /(\d+)\s+NOEUDS/o);
1073
    $nb_noeuds = $1;
1074
    last;
1075
  }
1076
  while(<Fher>) {
1077
    last if($no_noeud == $nb_noeuds);
1078
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/o);
1079
    $no_noeud = $1;
1080
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
1081
  }
1082

    
1083
  #-lecture des elements
1084
  my %tab_elements; my $nb_elts;
1085
  my $no_elt = 0;
1086
  while(<Fher>) {
1087
    next if(not /(\d+)\s+ELEMENTS/o);
1088
    $nb_elts = $1;
1089
    last;
1090
  }
1091
  while(<Fher>) {
1092
    last if($no_elt == $nb_elts);
1093
    next if(not /^\s*\d+\s+\w+\s+\w+/o);
1094
    s/^\s+//;s/\s+$//;
1095
    $_ =~ /^(\d+)\s+/;
1096
    $no_elt = $1; s/^(\d+)\s+//;
1097
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
1098
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
1099
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
1100
  }
1101
  close(Fher);
1102

    
1103

    
1104
  #------------------------
1105
  # lecture des references (dans le .her et dans un eventuel .lis)
1106
  #------------------------
1107
  my $flis = $fher; $flis =~ s/.her$/.lis/;
1108
  my $nom_liste;
1109
  my $is_liste_en_cours;
1110
  my %listes_NOEUDS;
1111
  my %listes_ARETES;
1112
  my %listes_FACES;
1113
  my %listes_ELEMENTS;
1114
  my %listes_PTI;
1115

    
1116
  #-dans le .her
1117
  open(Fher, "<$fher");
1118
  $is_liste_en_cours = 0;
1119
  while(<Fher>) {
1120
    chomp;
1121
    if(/^\s*(N\S+)/o) {
1122
      $nom_liste = $1;
1123
      $is_liste_en_cours = 1;
1124
      s/^\s*N\S+\s+//; s/\s+$//;
1125
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1126
    }
1127
    elsif(/^\s*noeuds/io or /^\s*elements/i or /^\s*[AFEG]/o) {
1128
      $is_liste_en_cours = 0;
1129
    }
1130
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1131
      s/^\s+//; s/\s+$//;
1132
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1133
    }
1134
  }
1135
  close(Fher);
1136

    
1137
  open(Fher, "<$fher");
1138
  $is_liste_en_cours = 0;
1139
  while(<Fher>) {
1140
    chomp;
1141
    if(/^\s*(A\S+)/o) {
1142
      $nom_liste = $1;
1143
      $is_liste_en_cours = 1;
1144
      s/^\s*A\S+\s+//; s/\s+$//;
1145
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1146
    }
1147
    elsif(/^\s*noeuds/io or /^\s*elements/i or /^\s*[NFEG]/o) {
1148
      $is_liste_en_cours = 0;
1149
    }
1150
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1151
      s/^\s+//; s/\s+$//;
1152
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1153
    }
1154
  }
1155
  close(Fher);
1156

    
1157
  open(Fher, "<$fher");
1158
  $is_liste_en_cours = 0;
1159
  while(<Fher>) {
1160
    chomp;
1161
    if(/^\s*(F\S+)/) {
1162
      $nom_liste = $1;
1163
      $is_liste_en_cours = 1;
1164
      s/^\s*F\S+\s+//; s/\s+$//;
1165
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1166
    }
1167
    elsif(/^\s*noeuds/io or /^\s*elements/i or /^\s*[NAEG]/o) {
1168
      $is_liste_en_cours = 0;
1169
    }
1170
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1171
      s/^\s+//; s/\s+$//;
1172
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1173
    }
1174
  }
1175
  close(Fher);
1176

    
1177
  open(Fher, "<$fher");
1178
  $is_liste_en_cours = 0;
1179
  while(<Fher>) {
1180
    chomp;
1181
    if(/^\s*(E\S+)/o) {
1182
      $nom_liste = $1;
1183
      $is_liste_en_cours = 1;
1184
      s/^\s*E\S+\s+//; s/\s+$//;
1185
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1186
    }
1187
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NAFG]/o) {
1188
      $is_liste_en_cours = 0;
1189
    }
1190
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1191
      s/^\s+//; s/\s+$//;
1192
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1193
    }
1194
  }
1195
  close(Fher);
1196

    
1197
  open(Fher, "<$fher");
1198
  $is_liste_en_cours = 0;
1199
  while(<Fher>) {
1200
    chomp;
1201
    if(/^\s*(G\S+)/o) {
1202
      $nom_liste = $1;
1203
      $is_liste_en_cours = 1;
1204
      s/^\s*G\S+\s+//; s/\s+$//;
1205
      push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_));
1206
    }
1207
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NAFE]/o) {
1208
      $is_liste_en_cours = 0;
1209
    }
1210
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1211
      s/^\s+//; s/\s+$//;
1212
      push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_));
1213
    }
1214
  }
1215
  close(Fher);
1216

    
1217

    
1218
  #dans le .lis (si il existe)
1219
  if(-e $flis) {
1220

    
1221
  open(Flis, "<$flis");
1222
  $is_liste_en_cours = 0;
1223
  while(<Flis>) {
1224
    chomp;
1225
    if(/^\s*(N\S+)/o) {
1226
      $nom_liste = $1;
1227
      $is_liste_en_cours = 1;
1228
      s/^\s*N\S+\s+//; s/\s+$//;
1229
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1230
    }
1231
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[AFEG]/o) {
1232
      $is_liste_en_cours = 0;
1233
    }
1234
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1235
      s/^\s+//; s/\s+$//;
1236
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1237
    }
1238
  }
1239
  close(Flis);
1240

    
1241
  open(Flis, "<$flis");
1242
  $is_liste_en_cours = 0;
1243
  while(<Flis>) {
1244
    chomp;
1245
    if(/^\s*(A\S+)/o) {
1246
      $nom_liste = $1;
1247
      $is_liste_en_cours = 1;
1248
      s/^\s*A\S+\s+//; s/\s+$//;
1249
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1250
    }
1251
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NFEG]/o) {
1252
      $is_liste_en_cours = 0;
1253
    }
1254
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1255
      s/^\s+//; s/\s+$//;
1256
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1257
    }
1258
  }
1259
  close(Flis);
1260

    
1261
  open(Flis, "<$flis");
1262
  $is_liste_en_cours = 0;
1263
  while(<Flis>) {
1264
    chomp;
1265
    if(/^\s*(F\S+)/o) {
1266
      $nom_liste = $1;
1267
      $is_liste_en_cours = 1;
1268
      s/^\s*F\S+\s+//; s/\s+$//;
1269
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1270
    }
1271
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NAEG]/o) {
1272
      $is_liste_en_cours = 0;
1273
    }
1274
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1275
      s/^\s+//; s/\s+$//;
1276
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1277
    }
1278
  }
1279
  close(Flis);
1280

    
1281
  open(Flis, "<$flis");
1282
  $is_liste_en_cours = 0;
1283
  while(<Flis>) {
1284
    chomp;
1285
    if(/^\s*(E\S+)/o) {
1286
      $nom_liste = $1;
1287
      $is_liste_en_cours = 1;
1288
      s/^\s*E\S+\s+//; s/\s+$//;
1289
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1290
    }
1291
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NAFG]/o) {
1292
      $is_liste_en_cours = 0;
1293
    }
1294
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1295
      s/^\s+//; s/\s+$//;
1296
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1297
    }
1298
  }
1299
  close(Flis);
1300

    
1301
  open(Flis, "<$flis");
1302
  $is_liste_en_cours = 0;
1303
  while(<Flis>) {
1304
    chomp;
1305
    if(/^\s*(G\S+)/o) {
1306
      $nom_liste = $1;
1307
      $is_liste_en_cours = 1;
1308
      s/^\s*G\S+\s+//; s/\s+$//;
1309
      push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_));
1310
    }
1311
    elsif(/^\s*noeuds/io or /^\s*elements/io or /^\s*[NAFE]/o) {
1312
      $is_liste_en_cours = 0;
1313
    }
1314
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1315
      s/^\s+//; s/\s+$//;
1316
      push(@{$listes_PTI{$nom_liste}},split(/\s+/,$_));
1317
    }
1318
  }
1319
  close(Flis);
1320

    
1321
  }#if(-e $flis)
1322

    
1323
  #AFFICHAGE DES LISTES DE NOEUDS
1324
  #foreach my $nom (keys(%listes_NOEUDS)) {
1325
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
1326
  #}
1327
  #AFFICHAGE DES LISTES D ARETES
1328
  #foreach my $nom (keys(%listes_ARETES)) {
1329
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
1330
  #}
1331
  #AFFICHAGE DES LISTES DE FACES
1332
  #foreach my $nom (keys(%listes_FACES)) {
1333
  #  print "$nom : @{$listes_FACES{$nom}}\n";
1334
  #}
1335
  #AFFICHAGE DES LISTES D ELEMENTS
1336
  #foreach my $nom (keys(%listes_ELEMENTS)) {
1337
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
1338
  #}
1339
  #AFFICHAGE DES LISTES DE POINTS D INTEGRATION
1340
  #foreach my $nom (keys(%listes_PTI)) {
1341
  #  print "$nom : @{$listes_PTI{$nom}}\n";
1342
  #}
1343

    
1344
  return($nom_maillage, $nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
1345
         \%listes_NOEUDS, \%listes_ARETES,
1346
         \%listes_FACES, \%listes_ELEMENTS, \%listes_PTI);
1347
}#sub lecture_mail_her
1348

    
1349

    
1350

    
1351

    
1352

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

    
1361
  #saisie du nombre d elements original
1362
  my @liste_elts_a_supprimer;
1363
  open(my $Hlocal, "<$fGmsh");
1364
  while(<$Hlocal>) {
1365
    if(not defined $nb_elts and /^\s*\$Elements/io) {
1366
      $_ = <$Hlocal>;
1367
      ($nb_elts) = $_ =~ /(\d+)/;
1368
      last;
1369
    }
1370
  }
1371

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

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

    
1384
    #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)
1385
    while(<$Hlocal>) {
1386
      last if(/^\s*\$EndElementData\s*$/io);
1387
      next if(not /^\s*(\d+)\s+\d+\s*$/o);
1388
      $elt_a_supprimer[$1] = 1;#on indique que c est un element a supprimer
1389
    }
1390
  }
1391
  close($Hlocal);
1392

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

    
1400
    #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)
1401
    $nb_elts_new++;
1402
    $tab_corresp_elt_old_new[$i] = $nb_elts_new;#nouveau numero pour cet element
1403
  }
1404

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

    
1410
  #traitement de la liste des elements
1411
  while(<$Hlocal>) {
1412
    print $Htmp $_;
1413
    next if(not /^\s*\$Elements/io);
1414
    <$Hlocal>;
1415
    print $Htmp "$nb_elts_new\n";
1416
    while(<$Hlocal>) {
1417
      if(/^\s*\$EndElements\s*$/io) {
1418
        print $Htmp $_;
1419
        last;
1420
      }
1421

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

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

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

    
1443
      #pas de recopie si c est une reference de faces
1444
      if($ligne =~ /^\s*\"\s*F\S+/o) {
1445
        while($ligne = <$Hlocal>) {
1446
          last if($ligne =~ /^\s*\$EndElementData\s*$/io);
1447
        }
1448
      }
1449
      #si c est autre chose qu une reference de face, on modifie les numeros d elements en fonction de la table de correspondance
1450
      else {
1451
        print $Htmp $entete;
1452
        while($ligne = <$Hlocal>) {
1453
          if($ligne =~ /^\s*(\d+)\s+\d+\s*$/o) {
1454
            my $no_elt = $1;
1455
            $ligne =~ s/^(\s*)\d+/$1$tab_corresp_elt_old_new[$no_elt]/;
1456
          }
1457
          print $Htmp $ligne;
1458
          last if($ligne =~ /^\s*\$EndElementData\s*$/io);
1459
        }
1460
      }
1461

    
1462
    }
1463

    
1464
    #autre chose qu un ElementData
1465
    else {
1466
      print $Htmp $ligne;
1467
    }
1468
  }
1469
  close($Htmp);
1470
  close($Hlocal);
1471

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