Projet

Général

Profil

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

version 1.023 (ajout option -quit : exécuter le script sans lancer la visualisation Gmsh. Utilisation typique : creer les fichiers de visualisation et les sauvegarder avec option -saveVisu sans lancer la visu Gmsh => hz_visuMail.pl -saveVisu -quit [liste - Julien Troufflard, 01/12/2015 12:02

 
1
#!/usr/bin/env perl
2

    
3
use strict;
4
use warnings;
5
use English;
6
use File::Spec::Functions qw(rel2abs);
7
use File::Basename;
8
my $NOM_PROG = basename $PROGRAM_NAME;
9

    
10

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

    
40

    
41

    
42

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

    
55

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

    
65
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
66
# FIN VARIABLES UTILISATEUR                                 #
67
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
68

    
69

    
70

    
71

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

    
77
  #indentation pour l affichage de Usage 2
78
  my $indent_Usage2 = ""; $indent_Usage2 .= " " for(1 .. length("          > $NOM_PROG "));
79

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

    
153

    
154

    
155
#------------------------------------
156
#option -h ou -help => affichage de l aide et arret
157
#------------------------------------
158
# rq : insensible a la casse
159
foreach my $arg (@ARGV) {
160
  if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
161
    affichage_aide();
162
    exit;
163
  }
164
}
165

    
166
#------------------------------------
167
#option -v => affichage de la version et arret
168
#------------------------------------
169
foreach my $arg (@ARGV) {
170
  if($arg eq '-v') {
171
    print "\n $NOM_PROG : version $VERSION\n\n";
172
    exit;
173
  }
174
}
175

    
176

    
177

    
178
#------------------------------------
179
#recuperation des arguments et options
180
#------------------------------------
181
my @liste_fher;#liste des maillages
182
my $is_opt_saveVisu = 0;#indicateur de l option -saveVisu (sauvegarde des fichiers .geo et _Gmsh.msh de visualisation)
183
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)
184

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

    
191
  #option -exeHZ
192
  if($opt eq '-exeHZ') {
193
    $exeHZ = shift(@ARGV);
194
  }
195
  #option -exeGMSH
196
  elsif($opt eq '-exeGMSH') {
197
    $exeGMSH = shift(@ARGV);
198
  }
199
  #option -saveVisu
200
  elsif($opt eq '-saveVisu') {
201
    $is_opt_saveVisu = 1;
202
  }
203
  #option -quit
204
  elsif($opt eq '-quit') {
205
    $is_opt_quit = 1;
206
  }
207

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

    
213
  #autres arguments
214
  else {
215
    push(@args,$opt);
216
  }
217
}#while($#ARGV != -1)
218

    
219

    
220
#---------------------
221
#verif de l executable Herezh
222
#---------------------
223
#si la variable $exeHZ n a pas ete renseigne au prealable => on selectionne l executable par defaut en fonction de la plateforme
224
if(not defined($exeHZ)) {
225
  #- - - - - -
226
  #type de plateforme
227
  #- - - - - -
228
  my $type_OS;
229
  #-avec uname
230
  if(verif_cmd('uname')) {
231
    $type_OS = qx(uname -a);
232
    chomp($type_OS);
233
  }
234
  #-sinon : warning (OS inconnue)
235
  else {warn "**Attention : impossible de saisir le type de systeme d exploitation avec uname -a ...\n";}
236

    
237
  #selection de l executable Herezh
238
  #-linux 64 bits
239
  if($type_OS =~ /linux/i and $type_OS =~ /x86_64/i) {$exeHZ = $EXE_HZ_Linux64bits;}
240
  #-MacOSX (darwin)
241
  elsif($type_OS =~ /darwin/i) {$exeHZ = $EXE_HZ_MacOSX;}
242
  #-tous les autres (y compris linux 32 bits)
243
  else{$exeHZ = $EXE_HZ_autres;}
244
}
245
#verif de l executable Herezh
246
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";
247

    
248
#---------------------
249
#verif de l executable Gmsh
250
#---------------------
251
#si la variable $exeGMSH n a pas ete renseigne au prealable => on selectionne l executable par defaut
252
$exeGMSH = $exeGMSH_defaut if(not defined($exeGMSH));
253
#verif de l executable Gmsh
254
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";
255

    
256

    
257

    
258

    
259

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

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

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

    
288
    push(@args, $choix);
289
  }
290
  print "\n";
291
}
292
#-verif de la validite des maillages
293
foreach my $arg (@args) {
294
  $arg .= '.her' if(not $arg =~ /\.her$/);#rajout de l extension .her si manquante
295
  #existence du fichier
296
  (-e $arg) or do {warn "**Attention : fichier $arg introuvable (on ignore ce fichier)...\n"; next;};
297
  #ouverture du fichier
298
  open(FIC, "<$arg") or do {warn "**Attention : impossible d ouvrir le fichier $arg (on ignore ce fichier)...\n"; next;};
299
  #est-ce un maillage Herezh ? (verif par la presence des mots noeuds et NOEUDS)
300
  my ($is_noeuds, $is_NOEUDS) = (0,0);
301
  while(<FIC>) {
302
    $is_noeuds = 1 if(/^\s*noeuds/);
303
    $is_NOEUDS = 1 if(/^\s*\d+\s+NOEUDS/);
304
    last if($is_NOEUDS);
305
  }
306
  close(FIC);
307
  $is_noeuds or do {warn "**Attention : le fichier $arg ne contient pas le mot \"noeuds\" (on ignore ce fichier)...\n"; next;};
308
  $is_NOEUDS or do {warn "**Attention : le fichier $arg ne contient pas le mot \"NOEUDS\" (on ignore ce fichier)...\n"; next;};
309

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

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

    
317

    
318

    
319
#---------------------
320
#verif des maillages (constitution de la liste des noms de maillage)
321
#---------------------
322
print "  verification des maillages...\n";
323
my @liste_nom_maillage;
324
#-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
325
if($#liste_fher == 0) {
326
  my $nom_maillage = '';
327
  open(FIC, "<$liste_fher[0]") or die "\n**Erreur (prog:$NOM_PROG) : impossible d ouvrir le fichier $liste_fher[0] ...\n\n";
328
  while(<FIC>) {
329
    last if(/^\s*noeuds/);
330
    next if(not /^\s*nom_maillage\s+(\S+)/);
331
    $nom_maillage = $1;
332
    last;
333
  }
334
  close(FIC);
335
  $nom_maillage = 'premier_maillage' if($nom_maillage eq '');
336
  push(@liste_nom_maillage, $nom_maillage);
337
}
338

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

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

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

    
365
    #cas d un maillage ayant le meme nom qu un ou plusieurs autres maillages
366
    my @liste_maillages_meme_nom = ();
367
    for(my $j=$i+1; $j<=$#liste_nom_maillage; $j++) {
368
      if($liste_nom_maillage[$i] eq $liste_nom_maillage[$j]) {
369
        $maillages_deja_traites[$j] = 1;
370
        push(@liste_maillages_meme_nom, $liste_fher[$j]);
371
      }
372
    }
373
    if($#liste_maillages_meme_nom > -1) {
374
      warn "**Erreur (prog:$NOM_PROG) : les maillages suivants ont le meme nom => $liste_fher[$i] @liste_maillages_meme_nom\n";
375
      $is_maillage_ok = 0;
376
    }
377
  }
378

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

    
383

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

    
393
#-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)
394
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)
395

    
396
#on boucle sur les maillages pour constituer les listes d elements par dimension de loi de comportement pour chaque maillage
397
# 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)
398
my $is_elt_1D = 0;#indicateur de la presence d au moins 1 element 1D
399
my $is_elt_2D = 0;#indicateur de la presence d au moins 1 element 2D
400
my $nb_elts_tot = 0;
401
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
402
  #saisie des elements
403
  my ($nb_elts, $ref_elements);
404
  ($_, $_, $_, $nb_elts, $ref_elements) = lecture_mail_her($liste_fher[$no_mail]);
405
  $nb_elts_tot += $nb_elts;
406
  my @ELEM_1D = ();
407
  my @ELEM_2D = ();
408
  my @ELEM_3D = ();
409
  ELEM:for(my $i=1; $i<=$nb_elts; $i++) {
410
    #verif si element AXI (=> loi LOI_RIEN3D )
411
    foreach my $suffixe (@SUFFIXE_AXI) {
412
      @_ = split(/\s+/, $ref_elements->{$i}{'TYPE'});
413
      if($_[0] =~ /$suffixe\s*$/) {
414
        push(@ELEM_3D, $i);
415
        next ELEM;
416
      }
417
    }
418
    #verif si element 1D (=> loi LOI_RIEN1D )
419
    foreach my $prefixe (@PREFIXE_1D) {
420
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
421
        push(@ELEM_1D, $i);
422
        $is_elt_1D = 1;
423
        next ELEM;
424
      }
425
    }
426
    #verif si element 2D (=> loi LOI_RIEN2D_C )
427
    foreach my $prefixe (@PREFIXE_2D) {
428
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
429
        push(@ELEM_2D, $i);
430
        $is_elt_2D = 1;
431
        next ELEM;
432
      }
433
    }
434
    #sinon, c est un element 3D (=> loi LOI_RIEN3D )
435
    push(@ELEM_3D, $i);
436
  }#FIN BOUCLE SUR LES ELEMENTS DU MAILLAGE indice $no_mail
437

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

    
443
}#FIN BOUCLE SUR LES MAILLAGES
444

    
445

    
446

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

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

    
470

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

    
476
#-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)
477
my $HZ_symbolic_link = 'HZppfast_'.$PID.'_hz_visuMail';
478
my $absolute_path_cmd = absolute_path_cmd($exeHZ);
479
#-creation du lien symbolique
480
system("ln -s $absolute_path_cmd $HZ_symbolic_link");
481
#-capture du signal ctrl+c
482
$SIG{INT} = sub {
483
  #kill des processus Herezh (on les repere grace au nom du lien symbolique $HZ_symbolic_link
484
  foreach my $processus (qx(ps -U $ENV{USER} -o pid,%cpu,command | grep $HZ_symbolic_link | grep -v grep)) {
485
    next if(not $processus =~ /^\s*(\d+)/);
486
    kill("TERM", $1);
487
  }
488

    
489
  #destruction des fichiers temporaires
490
  efface_fic_temporaires();
491

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

    
495

    
496

    
497

    
498
#---------------------
499
#ecriture du .info
500
#---------------------
501
open(FIC, ">$finfo");
502
print FIC "dimension 3\n\n";
503

    
504
print FIC "niveau_commentaire 1\n\n";
505

    
506
#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)
507
print FIC "TYPE_DE_CALCUL\ndynamique_explicite\n";
508

    
509
#ecriture des maillages et de references d elements speciales
510
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
511
  my $fher = $liste_fher[$no_mail];
512
  my $flis = $fher; $flis =~ s/.her$/.lis/;
513
  print FIC "\n< $fher\n";
514
  print FIC "< $flis\n" if(-e $flis);#inclusion du .lis si il existe
515
  #set d elements speciaux en fonction de la dimension de la loi de comportement
516
  #  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)
517
  foreach my $dim ('1D', '2D', '3D') {
518
    next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
519
    ecrire_liste_N_E(*FIC, "E_tmp_visu_elem_$dim", @{$TAB_DIM_LOI{$no_mail}{$dim}});
520
  }
521
}
522

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

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

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

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

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

    
561
print FIC "\ncharges\n\n";
562
print FIC "blocages\n\n";
563

    
564
#controle => un seul increment
565
print FIC "controle\n";
566
print FIC "DELTAt 1.\n";
567
print FIC "TEMPSFIN 1.\n";
568
print FIC "SAUVEGARDE 0\n";
569
print FIC "MAXINCRE 1\n";
570

    
571
print FIC "\npara_pilotage_equi_global\n\n";
572

    
573
print FIC "para_syteme_lineaire\n\n";
574

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

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

    
579
print FIC "_fin_point_info_\n";
580
close(FIC);
581

    
582

    
583
#---------------------
584
#ecriture du .CVisu
585
#---------------------
586
open(FIC, ">$fCVisu");
587
print FIC "
588
debut_fichier_commande_visu
589

    
590
  debut_visualisation_Gmsh
591
    debut_maillage_initial
592
      actif 1
593
      pseudo-homothetie_sur_les_maillages_ 0
594
      visualisation_references_sur_les_maillages_ 1
595
    fin_maillage_initial
596

    
597
    debut_choix_maillage
598
      actif 0
599
      1";
600
for(my $i=1; $i<=$#liste_fher; $i++) {$_ = $i + 1; print FIC " $_";}
601
print FIC " fin_choix_maillage
602
  fin_visualisation_Gmsh
603

    
604
fin_fichier_commande_visu
605
";
606
close(FIC);
607

    
608

    
609

    
610
#---------------------
611
#lancement du calcul
612
#---------------------
613
#-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)
614
my $fredir = "$racine_fic_tmp.log";
615
print "  creation du fichier _Gmsh.msh (calcul Herezh en cours)...\n";
616
system("rm -f $fGmsh $fredir");
617
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
618
#-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})
619
my $pid_fils = fork();
620
#---------- processus fils
621
            if($pid_fils == 0) {
622
              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
623
              exit;
624
            }
625
#---------- fin du processus fils
626
#attente de la fin du processus fils par son pere
627
waitpid($pid_fils, 0);
628

    
629

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

    
645
  #destruction des fichiers temporaires
646
  efface_fic_temporaires();
647

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

    
652

    
653
#---------------------
654
#lecture du .msh et reecriture pour modifier les couleurs selon le type de reference (noeud, arete, face, element)
655
#  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
656
#---------------------
657

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

    
672
#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)
673
#  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
674
my %table_couleur_type_ref = ('pt_integr'=>5, 'noeud'=>4, 'arete'=>3, 'face'=>2, 'element'=>1);
675

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

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

    
688
  #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)
689
  if($ligne =~ /^\s*\$ElementData\s*$/i) {
690
    my $entete = $ligne;
691
    #on lit jusqu au nom de la reference
692
    while($ligne = <FIC>) {
693
      $entete .= $ligne;
694
      last if($ligne =~ /^\s*\"/);
695
    }
696

    
697
    #selection de l isovaleur en fonction du type de reference
698
    #-ref de noeuds
699
    if($ligne =~ /^\s*\"\s*N(\S+)/) {
700
      push(@liste_type_reference, 'noeud');
701
      $couleur_type_ref = $table_couleur_type_ref{'noeud'};
702
    }
703
    #-ref d aretes
704
    elsif($ligne =~ /^\s*\"\s*A(\S+)/) {
705
      push(@liste_type_reference, 'arete');
706
      $couleur_type_ref = $table_couleur_type_ref{'arete'};
707
    }
708
    #-ref de faces
709
    elsif($ligne =~ /^\s*\"\s*F(\S+)/) {
710
      push(@liste_type_reference, 'face');
711
      $couleur_type_ref = $table_couleur_type_ref{'face'};
712
    }
713
    #-ref d elements
714
    elsif($ligne =~ /^\s*\"\s*E(\S+)/) {
715
      push(@liste_type_reference, 'element');
716
      $couleur_type_ref = $table_couleur_type_ref{'element'};
717
    }
718
    #-ref de points d integration
719
    elsif($ligne =~ /^\s*\"\s*G(\S+)/) {
720
      push(@liste_type_reference, 'pt_integr');
721
      $couleur_type_ref = $table_couleur_type_ref{'pt_integr'};
722
    }
723

    
724
    #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
725
    if($ligne =~ /E_tmp_visu_elem_/) {
726
      while($ligne = <FIC>) {last if($ligne =~ /^\s*\$EndElementData\s*$/i);}
727
      pop(@liste_type_reference);#suppression du dernier element de la liste
728
    }
729
    #si c est une reference reellement dans le maillage, on recopie l en-tete actuel et on recopie l element data avec l isovaleur
730
    else {
731
      $is_Element_data = 1;
732
      print Ftmp $entete;
733
      while($ligne = <FIC>) {
734
        $ligne = "$1 $couleur_type_ref\n" if ($ligne =~ /^\s*(\d+)\s+\d+\s*$/);
735
        print Ftmp $ligne;
736
        last if($ligne =~ /^\s*\$EndElementData\s*$/i);
737
      }
738
    }
739
  }#if($ligne =~ /^\s*\$ElementData\s*$/i)
740

    
741
  #cas general : on recopie simplement la ligne courante
742
  else {
743
    print Ftmp $ligne;
744
  }
745
}
746
close(FIC);
747

    
748
#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)
749
#  rq : les elements 1D se retrouvent egalement dans cette ref
750
print Ftmp "\$ElementData 
751
1 
752
\"Activer/Desactiver vue elements 2D 3D\"
753
0  
754
3 
755
0
756
1 
757
$nb_elts_tot\n";
758
for(my $i=1; $i<=$nb_elts_tot; $i++) {
759
  print Ftmp "$i 0\n";#isovaleur 0
760
}
761
print Ftmp "\$EndElementData\n";
762
close(Ftmp);
763
system("mv -f $ftmp $fGmsh");
764

    
765

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

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

    
779
#-options generales
780
print FIC '
781
Geometry.Light = 0;     //desactivation de la lumiere (geometrie)
782
Mesh.Light = 0;         //desactivation de la lumiere (maillage)
783
View.Light = 0;         //desactivation de la lumiere (vue)
784
Mesh.ColorCarousel = 0; //type de couleur (0=by element type, 1=by elementary entity, 2=by physical entity, 3=by partition)
785
Geometry.Points = 0;    //affichage des points (=0 desactiver, =1 activer)
786
Mesh.Points = 0;        //affichage des noeuds (=0 desactiver, =1 activer)
787
Mesh.Lines = 1;         //affichage des lignes (elements 1D) (=0 desactiver, =1 activer)
788
Mesh.SurfaceEdges = 1;  //affichage des aretes des elements 2D (=0 desactiver, =1 activer)
789
Mesh.SurfaceFaces = 0;  //affichage des faces des elements 2D (=0 desactiver, =1 activer)
790
Mesh.VolumeEdges = 1;   //affichage des aretes des elements 3D (=0 desactiver, =1 activer)
791
Mesh.VolumeFaces = 0;   //affichage des faces des elements 3D (=0 desactiver, =1 activer)
792
View.Visible = 0;       //desactivation de toutes les vues au demarrage
793
View.ShowScale = 0;     //desactivation de la vue de l echelle d isovaleur
794
View.RangeType = 2;     //type de bornes des isovaleurs (2=Custom)
795
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)
796
View.CustomMax = 5;     //borne maxi isovaleur
797
View.PointType = 1;     //type d affichage des points (1=3D sphere)
798
View.PointSize = 4.;    //taille des points
799
View.LineType = 1;      //type d affichage des lignes (1=3D cylinder)
800
View.LineWidth = 3.;    //taille des lignes
801

    
802
Mesh.PointSize = 3.;   //taille des noeuds
803
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
804
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
805
Mesh.Color.Triangles = {0,0,0};
806
Mesh.Color.Quadrangles = {0,0,0};
807
Mesh.Color.Tetrahedra = {0,0,0};
808
Mesh.Color.Hexahedra = {0,0,0};
809
Mesh.Color.Prisms = {0,0,0};
810
Mesh.Color.Pyramids = {0,0,0};
811
';
812

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

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

    
826
#on indique d afficher la vue speciale qui sert a afficher les faces des elements 2D 3D (la derniere qui a ete cree)
827
#  rq : pour cette vue, on remet l affichage classique pour les points et les lignes
828
print FIC "//options speciales pour la derniere vue qui sert a l affichage des faces des elements 2D et 3D\n";
829
$_ = $#liste_type_reference + 1;#cette vue n est pas enregistree dans la liste, son numero est donc egal a la derniere + 1
830
print FIC "View[$_].Visible = 1;\n";
831
print FIC "View[$_].PointType = 0;     //type d affichage des points (0=Color dot)\n";
832
print FIC "View[$_].PointSize = 3.;    //taille des points\n";
833
print FIC "View[$_].LineType = 0;		//type d affichage des lignes (0=Color segment)\n";
834
print FIC "View[$_].LineWidth = 1.; 	//taille des lignes\n";
835
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";
836

    
837
close(FIC);
838

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

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

    
855
#destruction des fichiers temporaires
856
efface_fic_temporaires();
857

    
858

    
859

    
860

    
861

    
862

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

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

    
881

    
882
#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 ??!!?!??!!!)
883
# N EST PLUS UTILISE DEPUIS LA VERSION 1.01 => A LA PLACE, ON UTILISE LA SUB verif_cmd()
884
##sub which_absolute {
885
##  use File::Which;
886
##  my $cmd = shift;
887
##  my @path;
888
##  #cas d une commande avec chemin absolu
889
##  if($cmd =~ /^\// and -x $cmd) {
890
##    @path = ($cmd);
891
##  }
892
##  #commande which classique
893
##  push(@path, which($cmd));
894
##  return(@path);
895
##}
896

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

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

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

    
909
  #cas ou la commande n existe pas
910
  return 0;
911
}
912

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

    
923
  my $absolute_cmd = 0;
924

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

    
930
  #2-
931
    #2-a : d abord dans les $PATH
932
    foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
933
      if(-e "$path/$cmd") {
934
        $absolute_cmd = rel2abs("$path/$cmd");
935
        last;
936
      }
937
    }
938
    #2-b : ensuite dans les repertoires hors $PATH
939
    if(-e $cmd) {
940
      $absolute_cmd = rel2abs($cmd);
941
    }
942

    
943

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

    
949
  return $absolute_cmd;
950
}#sub absolute_path_cmd
951

    
952

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

    
960
  my $cpt; my $cpt_max = 15; my $nb_blancs;
961

    
962
  $nb_blancs = ""; $nb_blancs .= " " for(1 .. length($nom_liste));
963
  $_ = shift(@liste_no);
964
  print $handle " $nom_liste $_";
965
  $cpt = 1;
966
  foreach my $no (@liste_no) {
967
    $cpt++;
968
    if($cpt == 1) {print $handle " $nb_blancs $no";}
969
    elsif($cpt == $cpt_max) {print $handle " $no\n"; $cpt = 0;}
970
    else {print $handle " $no";}
971
  }
972
  print $handle "\n" if($cpt != $cpt_max);
973
}#sub ecrire_liste_noeuds
974

    
975

    
976
#----------------
977
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
978
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
979
#
980
# exemple d appel :
981
#  my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her.her");
982
#
983
#  avec - $nom_maillage     : nom du maillage (si il y en a un. sinon $nom_maillage sera egal a undef
984
#       - $nb_noeuds        : nombre de noeuds (entier)
985
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
986
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
987
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
988
#       - $nb_elts          : nombre d elements (entier)
989
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
990
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
991
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
992
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
993
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
994
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
995
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
996
#
997
sub lecture_mail_her {
998
  my $fher = shift;
999

    
1000
  $fher .= '.her' if(not $fher =~ /\.her$/);
1001

    
1002
  my $nom_maillage;
1003

    
1004
  #------------------------
1005
  # lecture du maillage .her
1006
  #------------------------
1007
  #-lecture de noeuds
1008
  my @tab_noeuds; my $nb_noeuds;
1009
  my $no_noeud = 0;
1010
  open(Fher, "<$fher") or die "\nErreur (sub:lecture_mail_her) : impossible d ouvrir le fichier $fher ...\n\n";
1011
  while(<Fher>) {
1012
    if(/^\s*nom_maillage\s+(\S+)/) {$nom_maillage = $1; next;}
1013
    next if(not /(\d+)\s+NOEUDS/);
1014
    $nb_noeuds = $1;
1015
    last;
1016
  }
1017
  while(<Fher>) {
1018
    last if($no_noeud == $nb_noeuds);
1019
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);
1020
    $no_noeud = $1;
1021
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
1022
  }
1023

    
1024
  #-lecture des elements
1025
  my %tab_elements; my $nb_elts;
1026
  my $no_elt = 0;
1027
  while(<Fher>) {
1028
    next if(not /(\d+)\s+ELEMENTS/);
1029
    $nb_elts = $1;
1030
    last;
1031
  }
1032
  while(<Fher>) {
1033
    last if($no_elt == $nb_elts);
1034
    next if(not /^\s*\d+\s+\w+\s+\w+/);
1035
    s/^\s+//;s/\s+$//;
1036
    $_ =~ /^(\d+)\s+/;
1037
    $no_elt = $1; s/^(\d+)\s+//;
1038
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
1039
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
1040
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
1041
  }
1042
  close(Fher);
1043

    
1044

    
1045
  #------------------------
1046
  # lecture des references (dans le .her et dans un eventuel .lis)
1047
  #------------------------
1048
  my $flis = $fher; $flis =~ s/.her$/.lis/;
1049
  my $nom_liste;
1050
  my $is_liste_en_cours;
1051
  my %listes_NOEUDS;
1052
  my %listes_ARETES;
1053
  my %listes_FACES;
1054
  my %listes_ELEMENTS;
1055

    
1056
  #-dans le .her
1057
  open(Fher, "<$fher");
1058
  $is_liste_en_cours = 0;
1059
  while(<Fher>) {
1060
    chomp;
1061
    if(/^\s*(N\S+)/) {
1062
      $nom_liste = $1;
1063
      $is_liste_en_cours = 1;
1064
      s/^\s*N\S+\s+//; s/\s+$//;
1065
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1066
    }
1067
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
1068
      $is_liste_en_cours = 0;
1069
    }
1070
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1071
      s/^\s+//; s/\s+$//;
1072
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1073
    }
1074
  }
1075
  close(Fher);
1076

    
1077
  open(Fher, "<$fher");
1078
  $is_liste_en_cours = 0;
1079
  while(<Fher>) {
1080
    chomp;
1081
    if(/^\s*(A\S+)/) {
1082
      $nom_liste = $1;
1083
      $is_liste_en_cours = 1;
1084
      s/^\s*A\S+\s+//; s/\s+$//;
1085
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1086
    }
1087
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
1088
      $is_liste_en_cours = 0;
1089
    }
1090
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1091
      s/^\s+//; s/\s+$//;
1092
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1093
    }
1094
  }
1095
  close(Fher);
1096

    
1097
  open(Fher, "<$fher");
1098
  $is_liste_en_cours = 0;
1099
  while(<Fher>) {
1100
    chomp;
1101
    if(/^\s*(F\S+)/) {
1102
      $nom_liste = $1;
1103
      $is_liste_en_cours = 1;
1104
      s/^\s*F\S+\s+//; s/\s+$//;
1105
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1106
    }
1107
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
1108
      $is_liste_en_cours = 0;
1109
    }
1110
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1111
      s/^\s+//; s/\s+$//;
1112
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1113
    }
1114
  }
1115
  close(Fher);
1116

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

    
1137

    
1138
  #dans le .lis (si il existe)
1139
  if(-e $flis) {
1140

    
1141
  open(Flis, "<$flis") or die "\nErreur (sub:lecture_mail_her) : impossible d ouvrir le fichier $flis ...\n\n";
1142
  $is_liste_en_cours = 0;
1143
  while(<Flis>) {
1144
    chomp;
1145
    if(/^\s*(N\S+)/) {
1146
      $nom_liste = $1;
1147
      $is_liste_en_cours = 1;
1148
      s/^\s*N\S+\s+//; s/\s+$//;
1149
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1150
    }
1151
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
1152
      $is_liste_en_cours = 0;
1153
    }
1154
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1155
      s/^\s+//; s/\s+$//;
1156
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1157
    }
1158
  }
1159
  close(Flis);
1160

    
1161
  open(Flis, "<$flis");
1162
  $is_liste_en_cours = 0;
1163
  while(<Flis>) {
1164
    chomp;
1165
    if(/^\s*(A\S+)/) {
1166
      $nom_liste = $1;
1167
      $is_liste_en_cours = 1;
1168
      s/^\s*A\S+\s+//; s/\s+$//;
1169
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1170
    }
1171
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
1172
      $is_liste_en_cours = 0;
1173
    }
1174
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1175
      s/^\s+//; s/\s+$//;
1176
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1177
    }
1178
  }
1179
  close(Flis);
1180

    
1181
  open(Flis, "<$flis");
1182
  $is_liste_en_cours = 0;
1183
  while(<Flis>) {
1184
    chomp;
1185
    if(/^\s*(F\S+)/) {
1186
      $nom_liste = $1;
1187
      $is_liste_en_cours = 1;
1188
      s/^\s*F\S+\s+//; s/\s+$//;
1189
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1190
    }
1191
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
1192
      $is_liste_en_cours = 0;
1193
    }
1194
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1195
      s/^\s+//; s/\s+$//;
1196
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1197
    }
1198
  }
1199
  close(Flis);
1200

    
1201
  open(Flis, "<$flis");
1202
  $is_liste_en_cours = 0;
1203
  while(<Flis>) {
1204
    chomp;
1205
    if(/^\s*(E\S+)/) {
1206
      $nom_liste = $1;
1207
      $is_liste_en_cours = 1;
1208
      s/^\s*E\S+\s+//; s/\s+$//;
1209
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1210
    }
1211
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
1212
      $is_liste_en_cours = 0;
1213
    }
1214
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1215
      s/^\s+//; s/\s+$//;
1216
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1217
    }
1218
  }
1219
  close(Flis);
1220

    
1221
  }#if(-e $flis)
1222

    
1223
  #AFFICHAGE DES LISTES DE NOEUDS
1224
  #foreach my $nom (keys(%listes_NOEUDS)) {
1225
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
1226
  #}
1227
  #AFFICHAGE DES LISTES D ARETES
1228
  #foreach my $nom (keys(%listes_ARETES)) {
1229
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
1230
  #}
1231
  #AFFICHAGE DES LISTES DE FACES
1232
  #foreach my $nom (keys(%listes_FACES)) {
1233
  #  print "$nom : @{$listes_FACES{$nom}}\n";
1234
  #}
1235
  #AFFICHAGE DES LISTES D ELEMENTS
1236
  #foreach my $nom (keys(%listes_ELEMENTS)) {
1237
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
1238
  #}
1239

    
1240
  return($nom_maillage, $nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
1241
         \%listes_NOEUDS, \%listes_ARETES,
1242
         \%listes_FACES, \%listes_ELEMENTS);
1243
}#sub lecture_mail_her
(6-6/24)
Redmine Appliance - Powered by TurnKey Linux