Projet

Général

Profil

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

version 1.02 (modif pour sortir proprement du programme avec ctrl+c, typiquement quand on ne veut pas attendre la fin du calcul Herezh) - Julien Troufflard, 03/06/2015 16:54

 
1
#!/usr/bin/perl
2
#!/usr/local/bin/perl
3
use strict;
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.02';
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
#####################################################################################################
26

    
27

    
28

    
29

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

    
42

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

    
52
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
53
# FIN VARIABLES UTILISATEUR                                 #
54
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
55

    
56

    
57

    
58

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

    
64
  #indentation pour l affichage de Usage 2
65
  my $indent_Usage2 = ""; $indent_Usage2 .= " " for(1 .. length("          > $NOM_PROG "));
66

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

    
136

    
137

    
138
#------------------------------------
139
#option -h ou -help => affichage de l aide et arret
140
#------------------------------------
141
# rq : insensible a la casse
142
foreach my $arg (@ARGV) {
143
  if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
144
    affichage_aide();
145
    exit;
146
  }
147
}
148

    
149
#------------------------------------
150
#option -v => affichage de la version et arret
151
#------------------------------------
152
foreach my $arg (@ARGV) {
153
  if($arg eq '-v') {
154
    print "\n $NOM_PROG : version $VERSION\n\n";
155
    exit;
156
  }
157
}
158

    
159

    
160

    
161
#------------------------------------
162
#recuperation des arguments et options
163
#------------------------------------
164
my @liste_fher;#liste des maillages
165
my $is_opt_saveVisu = 0;#indicateur de l option -saveVisu (sauvegarde des fichiers .geo et _Gmsh.msh de visualisation)
166

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

    
173
  #option -exeHZ
174
  if($opt eq '-exeHZ') {
175
    $exeHZ = shift(@ARGV);
176
  }
177
  #option -exeGMSH
178
  elsif($opt eq '-exeGMSH') {
179
    $exeGMSH = shift(@ARGV);
180
  }
181
  #option -saveVisu
182
  elsif($opt eq '-saveVisu') {
183
    $is_opt_saveVisu = 1;
184
  }
185

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

    
191
  #autres arguments
192
  else {
193
    push(@args,$opt);
194
  }
195
}#while($#ARGV != -1)
196

    
197

    
198
#---------------------
199
#verif de l executable Herezh
200
#---------------------
201
#si la variable $exeHZ n a pas ete renseigne au prealable => on selectionne l executable par defaut en fonction de la plateforme
202
if(not defined($exeHZ)) {
203
  #- - - - - -
204
  #type de plateforme
205
  #- - - - - -
206
  my $type_OS;
207
  #-avec uname
208
  if(verif_cmd('uname')) {
209
    $type_OS = qx(uname -a);
210
    chomp($type_OS);
211
  }
212
  #-sinon : warning (OS inconnue)
213
  else {warn "**Attention : impossible de saisir le type de systeme d exploitation avec uname -a ...\n";}
214

    
215
  #selection de l executable Herezh
216
  #-linux 64 bits
217
  if($type_OS =~ /linux/i and $type_OS =~ /x86_64/i) {$exeHZ = $EXE_HZ_Linux64bits;}
218
  #-MacOSX (darwin)
219
  elsif($type_OS =~ /darwin/i) {$exeHZ = $EXE_HZ_MacOSX;}
220
  #-tous les autres (y compris linux 32 bits)
221
  else{$exeHZ = $EXE_HZ_autres;}
222
}
223
#verif de l executable Herezh
224
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";
225

    
226
#---------------------
227
#verif de l executable Gmsh
228
#---------------------
229
#si la variable $exeGMSH n a pas ete renseigne au prealable => on selectionne l executable par defaut
230
$exeGMSH = $exeGMSH_defaut if(not defined($exeGMSH));
231
#verif de l executable Gmsh
232
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";
233

    
234

    
235

    
236

    
237

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

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

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

    
266
    push(@args, $choix);
267
  }
268
  print "\n";
269
}
270
#-verif de la validite des maillages
271
foreach my $arg (@args) {
272
  $arg .= '.her' if(not $arg =~ /\.her$/);#rajout de l extension .her si manquante
273
  #existence du fichier
274
  (-e $arg) or do {warn "**Attention : fichier $arg introuvable (on ignore ce fichier)...\n"; next;};
275
  #ouverture du fichier
276
  open(FIC, "<$arg") or do {warn "**Attention : impossible d ouvrir le fichier $arg (on ignore ce fichier)...\n"; next;};
277
  #est-ce un maillage Herezh ? (verif par la presence des mots noeuds et NOEUDS)
278
  my ($is_noeuds, $is_NOEUDS) = (0,0);
279
  while(<FIC>) {
280
    $is_noeuds = 1 if(/^\s*noeuds/);
281
    $is_NOEUDS = 1 if(/^\s*\d+\s+NOEUDS/);
282
    last if($is_NOEUDS);
283
  }
284
  close(FIC);
285
  $is_noeuds or do {warn "**Attention : le fichier $arg ne contient pas le mot \"noeuds\" (on ignore ce fichier)...\n"; next;};
286
  $is_NOEUDS or do {warn "**Attention : le fichier $arg ne contient pas le mot \"NOEUDS\" (on ignore ce fichier)...\n"; next;};
287

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

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

    
295

    
296

    
297
#---------------------
298
#verif des maillages (constitution de la liste des noms de maillage)
299
#---------------------
300
print "  verification des maillages...\n";
301
my @liste_nom_maillage;
302
#-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
303
if($#liste_fher == 0) {
304
  my $nom_maillage = '';
305
  open(FIC, "<$liste_fher[0]") or die "\n**Erreur (prog:$NOM_PROG) : impossible d ouvrir le fichier $liste_fher[0] ...\n\n";
306
  while(<FIC>) {
307
    last if(/^\s*noeuds/);
308
    next if(not /^\s*nom_maillage\s+(\S+)/);
309
    $nom_maillage = $1;
310
    last;
311
  }
312
  close(FIC);
313
  $nom_maillage = 'premier_maillage' if($nom_maillage eq '');
314
  push(@liste_nom_maillage, $nom_maillage);
315
}
316

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

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

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

    
343
    #cas d un maillage ayant le meme nom qu un ou plusieurs autres maillages
344
    my @liste_maillages_meme_nom = ();
345
    for(my $j=$i+1; $j<=$#liste_nom_maillage; $j++) {
346
      if($liste_nom_maillage[$i] eq $liste_nom_maillage[$j]) {
347
        $maillages_deja_traites[$j] = 1;
348
        push(@liste_maillages_meme_nom, $liste_fher[$j]);
349
      }
350
    }
351
    if($#liste_maillages_meme_nom > -1) {
352
      warn "**Erreur (prog:$NOM_PROG) : les maillages suivants ont le meme nom => $liste_fher[$i] @liste_maillages_meme_nom\n";
353
      $is_maillage_ok = 0;
354
    }
355
  }
356

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

    
361

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

    
371
#-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)
372
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)
373

    
374
#on boucle sur les maillages pour constituer les listes d elements par dimension de loi de comportement pour chaque maillage
375
# 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)
376
my $is_elt_1D = 0;#indicateur de la presence d au moins 1 element 1D
377
my $is_elt_2D = 0;#indicateur de la presence d au moins 1 element 2D
378
my $nb_elts_tot = 0;
379
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
380
  #saisie des elements
381
  my ($nb_elts, $ref_elements);
382
  ($_, $_, $_, $nb_elts, $ref_elements) = lecture_mail_her($liste_fher[$no_mail]);
383
  $nb_elts_tot += $nb_elts;
384
  my @ELEM_1D = ();
385
  my @ELEM_2D = ();
386
  my @ELEM_3D = ();
387
  ELEM:for(my $i=1; $i<=$nb_elts; $i++) {
388
    #verif si element AXI (=> loi LOI_RIEN3D )
389
    foreach my $suffixe (@SUFFIXE_AXI) {
390
      @_ = split(/\s+/, $ref_elements->{$i}{'TYPE'});
391
      if($_[0] =~ /$suffixe\s*$/) {
392
        push(@ELEM_3D, $i);
393
        next ELEM;
394
      }
395
    }
396
    #verif si element 1D (=> loi LOI_RIEN1D )
397
    foreach my $prefixe (@PREFIXE_1D) {
398
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
399
        push(@ELEM_1D, $i);
400
        $is_elt_1D = 1;
401
        next ELEM;
402
      }
403
    }
404
    #verif si element 2D (=> loi LOI_RIEN2D_C )
405
    foreach my $prefixe (@PREFIXE_2D) {
406
      if($ref_elements->{$i}{'TYPE'} =~ /^\s*$prefixe/) {
407
        push(@ELEM_2D, $i);
408
        $is_elt_2D = 1;
409
        next ELEM;
410
      }
411
    }
412
    #sinon, c est un element 3D (=> loi LOI_RIEN3D )
413
    push(@ELEM_3D, $i);
414
  }#FIN BOUCLE SUR LES ELEMENTS DU MAILLAGE indice $no_mail
415

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

    
421
}#FIN BOUCLE SUR LES MAILLAGES
422

    
423

    
424

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

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

    
448

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

    
454
#-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)
455
my $HZ_symbolic_link = 'HZppfast_'.$PID.'_hz_visuMail';
456
my $absolute_path_cmd = absolute_path_cmd($exeHZ);
457
#-creation du lien symbolique
458
system("ln -s $absolute_path_cmd $HZ_symbolic_link");
459
#-capture du signal ctrl+c
460
$SIG{INT} = sub {
461
  #kill des processus Herezh (on les repere grace au nom du lien symbolique $HZ_symbolic_link
462
  foreach my $processus (qx(ps -U $ENV{USER} -o pid,%cpu,command | grep $HZ_symbolic_link | grep -v grep)) {
463
    next if(not $processus =~ /^\s*(\d+)/);
464
    kill("TERM", $1);
465
  }
466

    
467
  #destruction des fichiers temporaires
468
  efface_fic_temporaires();
469

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

    
473

    
474

    
475

    
476
#---------------------
477
#ecriture du .info
478
#---------------------
479
open(FIC, ">$finfo");
480
print FIC "dimension 3\n\n";
481

    
482
print FIC "niveau_commentaire 1\n\n";
483

    
484
#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)
485
print FIC "TYPE_DE_CALCUL\ndynamique_explicite avec plus lectureCommandesVisu\n";
486

    
487
#ecriture des maillages et de references d elements speciales
488
for(my $no_mail=0; $no_mail<=$#liste_fher; $no_mail++) {
489
  my $fher = $liste_fher[$no_mail];
490
  my $flis = $fher; $flis =~ s/.her$/.lis/;
491
  print FIC "\n< $fher\n";
492
  print FIC "< $flis\n" if(-e $flis);#inclusion du .lis si il existe
493
  #set d elements speciaux en fonction de la dimension de la loi de comportement
494
  #  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)
495
  foreach my $dim ('1D', '2D', '3D') {
496
    next if($#{$TAB_DIM_LOI{$no_mail}{$dim}} == -1);#pas d ecriture si aucun element de dimension $dim
497
    ecrire_liste_N_E(*FIC, "E_tmp_visu_elem_$dim", @{$TAB_DIM_LOI{$no_mail}{$dim}});
498
  }
499
}
500

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

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

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

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

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

    
539
print FIC "\ncharges\n\n";
540
print FIC "blocages\n\n";
541

    
542
#controle => un seul increment
543
print FIC "controle\n";
544
print FIC "DELTAt 1.\n";
545
print FIC "TEMPSFIN 1.\n";
546
print FIC "SAUVEGARDE 0\n";
547
print FIC "MAXINCRE 1\n";
548

    
549
print FIC "\npara_pilotage_equi_global\n\n";
550

    
551
print FIC "para_syteme_lineaire\n\n";
552

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

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

    
557
print FIC "_fin_point_info_\n";
558
close(FIC);
559

    
560

    
561
#---------------------
562
#ecriture du .CVisu
563
#---------------------
564
open(FIC, ">$fCVisu");
565
print FIC "
566
debut_fichier_commande_visu
567

    
568
  debut_visualisation_Gmsh
569
    debut_maillage_initial
570
      actif 1
571
      pseudo-homothetie_sur_les_maillages_ 0
572
      visualisation_references_sur_les_maillages_ 1
573
    fin_maillage_initial
574

    
575
    debut_choix_maillage
576
      actif 0
577
      1";
578
for(my $i=1; $i<=$#liste_fher; $i++) {$_ = $i + 1; print FIC " $_";}
579
print FIC " fin_choix_maillage
580
  fin_visualisation_Gmsh
581

    
582
fin_fichier_commande_visu
583
";
584
close(FIC);
585

    
586

    
587

    
588
#---------------------
589
#lancement du calcul
590
#---------------------
591
#-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)
592
my $fredir = "$racine_fic_tmp.log";
593
print "  creation du fichier _Gmsh.msh (calcul Herezh en cours)...\n";
594
system("rm -f $fGmsh $fredir");
595
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
596
#-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})
597
my $pid_fils = fork();
598
#---------- processus fils
599
            if($pid_fils == 0) {
600
              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
601
              exit;
602
            }
603
#---------- fin du processus fils
604
#attente de la fin du processus fils par son pere
605
waitpid($pid_fils, 0);
606

    
607

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

    
623
  #destruction des fichiers temporaires
624
  efface_fic_temporaires();
625

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

    
630

    
631
#---------------------
632
#lecture du .msh et reecriture pour modifier les couleurs selon le type de reference (noeud, arete, face, element)
633
#  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
634
#---------------------
635

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

    
650
#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)
651
#  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
652
my %table_couleur_type_ref = ('pt_integr'=>5, 'noeud'=>4, 'arete'=>3, 'face'=>2, 'element'=>1);
653

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

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

    
666
  #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)
667
  if($ligne =~ /^\s*\$ElementData\s*$/i) {
668
    my $entete = $ligne;
669
    #on lit jusqu au nom de la reference
670
    while($ligne = <FIC>) {
671
      $entete .= $ligne;
672
      last if($ligne =~ /^\s*\"/);
673
    }
674

    
675
    #selection de l isovaleur en fonction du type de reference
676
    #-ref de noeuds
677
    if($ligne =~ /^\s*\"\s*N(\S+)/) {
678
      push(@liste_type_reference, 'noeud');
679
      $couleur_type_ref = $table_couleur_type_ref{'noeud'};
680
    }
681
    #-ref d aretes
682
    elsif($ligne =~ /^\s*\"\s*A(\S+)/) {
683
      push(@liste_type_reference, 'arete');
684
      $couleur_type_ref = $table_couleur_type_ref{'arete'};
685
    }
686
    #-ref de faces
687
    elsif($ligne =~ /^\s*\"\s*F(\S+)/) {
688
      push(@liste_type_reference, 'face');
689
      $couleur_type_ref = $table_couleur_type_ref{'face'};
690
    }
691
    #-ref d elements
692
    elsif($ligne =~ /^\s*\"\s*E(\S+)/) {
693
      push(@liste_type_reference, 'element');
694
      $couleur_type_ref = $table_couleur_type_ref{'element'};
695
    }
696
    #-ref de points d integration
697
    elsif($ligne =~ /^\s*\"\s*G(\S+)/) {
698
      push(@liste_type_reference, 'pt_integr');
699
      $couleur_type_ref = $table_couleur_type_ref{'pt_integr'};
700
    }
701

    
702
    #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
703
    if($ligne =~ /E_tmp_visu_elem_/) {
704
      while($ligne = <FIC>) {last if($ligne =~ /^\s*\$EndElementData\s*$/i);}
705
      pop(@liste_type_reference);#suppression du dernier element de la liste
706
    }
707
    #si c est une reference reellement dans le maillage, on recopie l en-tete actuel et on recopie l element data avec l isovaleur
708
    else {
709
      $is_Element_data = 1;
710
      print Ftmp $entete;
711
      while($ligne = <FIC>) {
712
        $ligne = "$1 $couleur_type_ref\n" if ($ligne =~ /^\s*(\d+)\s+\d+\s*$/);
713
        print Ftmp $ligne;
714
        last if($ligne =~ /^\s*\$EndElementData\s*$/i);
715
      }
716
    }
717
  }#if($ligne =~ /^\s*\$ElementData\s*$/i)
718

    
719
  #cas general : on recopie simplement la ligne courante
720
  else {
721
    print Ftmp $ligne;
722
  }
723
}
724
close(FIC);
725

    
726
#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)
727
#  rq : les elements 1D se retrouvent egalement dans cette ref
728
print Ftmp "\$ElementData 
729
1 
730
\"Activer/Desactiver vue elements 2D 3D\"
731
0  
732
3 
733
0
734
1 
735
$nb_elts_tot\n";
736
for(my $i=1; $i<=$nb_elts_tot; $i++) {
737
  print Ftmp "$i 0\n";#isovaleur 0
738
}
739
print Ftmp "\$EndElementData\n";
740
close(Ftmp);
741
system("mv -f $ftmp $fGmsh");
742

    
743

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

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

    
757
#-options generales
758
print FIC '
759
Geometry.Light = 0;     //desactivation de la lumiere (geometrie)
760
Mesh.Light = 0;         //desactivation de la lumiere (maillage)
761
View.Light = 0;         //desactivation de la lumiere (vue)
762
Mesh.ColorCarousel = 0; //type de couleur (0=by element type, 1=by elementary entity, 2=by physical entity, 3=by partition)
763
Geometry.Points = 0;    //affichage des points (=0 desactiver, =1 activer)
764
Mesh.Points = 0;        //affichage des noeuds (=0 desactiver, =1 activer)
765
Mesh.Lines = 1;         //affichage des lignes (elements 1D) (=0 desactiver, =1 activer)
766
Mesh.SurfaceEdges = 1;  //affichage des aretes des elements 2D (=0 desactiver, =1 activer)
767
Mesh.SurfaceFaces = 0;  //affichage des faces des elements 2D (=0 desactiver, =1 activer)
768
Mesh.VolumeEdges = 1;   //affichage des aretes des elements 3D (=0 desactiver, =1 activer)
769
Mesh.VolumeFaces = 0;   //affichage des faces des elements 3D (=0 desactiver, =1 activer)
770
View.Visible = 0;       //desactivation de toutes les vues au demarrage
771
View.ShowScale = 0;     //desactivation de la vue de l echelle d isovaleur
772
View.RangeType = 2;     //type de bornes des isovaleurs (2=Custom)
773
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)
774
View.CustomMax = 5;     //borne maxi isovaleur
775
View.PointType = 1;     //type d affichage des points (1=3D sphere)
776
View.PointSize = 4.;    //taille des points
777
View.LineType = 1;      //type d affichage des lignes (1=3D cylinder)
778
View.LineWidth = 3.;    //taille des lignes
779

    
780
Mesh.PointSize = 3.;   //taille des noeuds
781
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
782
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
783
Mesh.Color.Triangles = {0,0,0};
784
Mesh.Color.Quadrangles = {0,0,0};
785
Mesh.Color.Tetrahedra = {0,0,0};
786
Mesh.Color.Hexahedra = {0,0,0};
787
Mesh.Color.Prisms = {0,0,0};
788
Mesh.Color.Pyramids = {0,0,0};
789
';
790

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

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

    
804
#on indique d afficher la vue speciale qui sert a afficher les faces des elements 2D 3D (la derniere qui a ete cree)
805
#  rq : pour cette vue, on remet l affichage classique pour les points et les lignes
806
print FIC "//options speciales pour la derniere vue qui sert a l affichage des faces des elements 2D et 3D\n";
807
$_ = $#liste_type_reference + 1;#cette vue n est pas enregistree dans la liste, son numero est donc egal a la derniere + 1
808
print FIC "View[$_].Visible = 1;\n";
809
print FIC "View[$_].PointType = 0;     //type d affichage des points (0=Color dot)\n";
810
print FIC "View[$_].PointSize = 3.;    //taille des points\n";
811
print FIC "View[$_].LineType = 0;		//type d affichage des lignes (0=Color segment)\n";
812
print FIC "View[$_].LineWidth = 1.; 	//taille des lignes\n";
813
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";
814

    
815
close(FIC);
816

    
817
print "  visu Gmsh en cours (via fichiers $fgeo et $fGmsh)...\n";
818
system("$exeGMSH $fgeo");
819

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

    
827
#destruction des fichiers temporaires
828
efface_fic_temporaires();
829

    
830

    
831

    
832

    
833

    
834

    
835
#rq : cette subroutine utilise les variables globales $racine_fic_tmp et @liste_fic_a_ne_pas_effacer
836
sub efface_fic_temporaires {
837
  #on transforme la liste des fichiers a ne pas effacer en table d indicateur (liste @liste_fic_a_ne_pas_effacer)
838
  my %NE_PAS_EFFACER;
839
  foreach my $fic (@liste_fic_a_ne_pas_effacer) {$NE_PAS_EFFACER{$fic} = 1;}
840
  #on saisit la liste actuelle des fichiers qui commencent comme le fichier .info
841
  my @liste_fic_actuelle = glob("$racine_fic_tmp*");
842
  #on efface seulement ceux qui n ont pas d indicateur %NE_PAS_EFFACER
843
  foreach my $fic (@liste_fic_actuelle) {
844
    system("rm -rf $fic") if(not defined($NE_PAS_EFFACER{$fic}));
845
  }
846
  #on efface le lien symbolique vers la commande Herezh
847
  system("rm -f $HZ_symbolic_link");
848
}
849

    
850

    
851
#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 ??!!?!??!!!)
852
# N EST PLUS UTILISE DEPUIS LA VERSION 1.01 => A LA PLACE, ON UTILISE LA SUB verif_cmd()
853
##sub which_absolute {
854
##  use File::Which;
855
##  my $cmd = shift;
856
##  my @path;
857
##  #cas d une commande avec chemin absolu
858
##  if($cmd =~ /^\// and -x $cmd) {
859
##    @path = ($cmd);
860
##  }
861
##  #commande which classique
862
##  push(@path, which($cmd));
863
##  return(@path);
864
##}
865

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

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

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

    
878
  #cas ou la commande n existe pas
879
  return 0;
880
}
881

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

    
892
  my $absolute_cmd = 0;
893

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

    
899
  #2-
900
    #2-a : d abord dans les $PATH
901
    foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
902
      if(-e "$path/$cmd") {
903
        $absolute_cmd = rel2abs("$path/$cmd");
904
        last;
905
      }
906
    }
907
    #2-b : ensuite dans les repertoires hors $PATH
908
    if(-e $cmd) {
909
      $absolute_cmd = rel2abs($cmd);
910
    }
911

    
912

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

    
918
  return $absolute_cmd;
919
}#sub absolute_path_cmd
920

    
921

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

    
929
  my $cpt; my $cpt_max = 15; my $nb_blancs;
930

    
931
  $nb_blancs = ""; $nb_blancs .= " " for(1 .. length($nom_liste));
932
  $_ = shift(@liste_no);
933
  print $handle " $nom_liste $_";
934
  $cpt = 1;
935
  foreach my $no (@liste_no) {
936
    $cpt++;
937
    if($cpt == 1) {print $handle " $nb_blancs $no";}
938
    elsif($cpt == $cpt_max) {print $handle " $no\n"; $cpt = 0;}
939
    else {print $handle " $no";}
940
  }
941
  print $handle "\n" if($cpt != $cpt_max);
942
}#sub ecrire_liste_noeuds
943

    
944

    
945
#----------------
946
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
947
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
948
#
949
# exemple d appel :
950
#  my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her.her");
951
#
952
#  avec - $nom_maillage     : nom du maillage (si il y en a un. sinon $nom_maillage sera egal a undef
953
#       - $nb_noeuds        : nombre de noeuds (entier)
954
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
955
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
956
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
957
#       - $nb_elts          : nombre d elements (entier)
958
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
959
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
960
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
961
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
962
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
963
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
964
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
965
#
966
sub lecture_mail_her {
967
  my $fher = shift;
968

    
969
  $fher .= '.her' if(not $fher =~ /\.her$/);
970

    
971
  my $nom_maillage;
972

    
973
  #------------------------
974
  # lecture du maillage .her
975
  #------------------------
976
  #-lecture de noeuds
977
  my @tab_noeuds; my $nb_noeuds;
978
  my $no_noeud;
979
  open(Fher, "<$fher") or die "\nErreur (sub:lecture_mail_her) : impossible d ouvrir le fichier $fher ...\n\n";
980
  while(<Fher>) {
981
    if(/^\s*nom_maillage\s+(\S+)/) {$nom_maillage = $1; next;}
982
    next if(not /(\d+)\s+NOEUDS/);
983
    $nb_noeuds = $1;
984
    last;
985
  }
986
  while(<Fher>) {
987
    last if($no_noeud == $nb_noeuds);
988
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);
989
    $no_noeud = $1;
990
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
991
  }
992

    
993
  #-lecture des elements
994
  my %tab_elements; my $nb_elts;
995
  my $no_elt;
996
  while(<Fher>) {
997
    next if(not /(\d+)\s+ELEMENTS/);
998
    $nb_elts = $1;
999
    last;
1000
  }
1001
  while(<Fher>) {
1002
    last if($no_elt == $nb_elts);
1003
    next if(not /^\s*\d+\s+\w+\s+\w+/);
1004
    s/^\s+//;s/\s+$//;
1005
    $_ =~ /^(\d+)\s+/;
1006
    $no_elt = $1; s/^(\d+)\s+//;
1007
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
1008
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
1009
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
1010
  }
1011
  close(Fher);
1012

    
1013

    
1014
  #------------------------
1015
  # lecture des references (dans le .her et dans un eventuel .lis)
1016
  #------------------------
1017
  my $flis = $fher; $flis =~ s/.her$/.lis/;
1018
  my $nom_liste;
1019
  my $is_liste_en_cours;
1020
  my %listes_NOEUDS;
1021
  my %listes_ARETES;
1022
  my %listes_FACES;
1023
  my %listes_ELEMENTS;
1024

    
1025
  #-dans le .her
1026
  open(Fher, "<$fher");
1027
  $is_liste_en_cours = 0;
1028
  while(<Fher>) {
1029
    chomp;
1030
    if(/^\s*(N\S+)/) {
1031
      $nom_liste = $1;
1032
      $is_liste_en_cours = 1;
1033
      s/^\s*N\S+\s+//; s/\s+$//;
1034
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1035
    }
1036
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
1037
      $is_liste_en_cours = 0;
1038
    }
1039
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1040
      s/^\s+//; s/\s+$//;
1041
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1042
    }
1043
  }
1044
  close(Fher);
1045

    
1046
  open(Fher, "<$fher");
1047
  $is_liste_en_cours = 0;
1048
  while(<Fher>) {
1049
    chomp;
1050
    if(/^\s*(A\S+)/) {
1051
      $nom_liste = $1;
1052
      $is_liste_en_cours = 1;
1053
      s/^\s*A\S+\s+//; s/\s+$//;
1054
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1055
    }
1056
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
1057
      $is_liste_en_cours = 0;
1058
    }
1059
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1060
      s/^\s+//; s/\s+$//;
1061
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1062
    }
1063
  }
1064
  close(Fher);
1065

    
1066
  open(Fher, "<$fher");
1067
  $is_liste_en_cours = 0;
1068
  while(<Fher>) {
1069
    chomp;
1070
    if(/^\s*(F\S+)/) {
1071
      $nom_liste = $1;
1072
      $is_liste_en_cours = 1;
1073
      s/^\s*F\S+\s+//; s/\s+$//;
1074
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1075
    }
1076
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
1077
      $is_liste_en_cours = 0;
1078
    }
1079
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1080
      s/^\s+//; s/\s+$//;
1081
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1082
    }
1083
  }
1084
  close(Fher);
1085

    
1086
  open(Fher, "<$fher");
1087
  $is_liste_en_cours = 0;
1088
  while(<Fher>) {
1089
    chomp;
1090
    if(/^\s*(E\S+)/) {
1091
      $nom_liste = $1;
1092
      $is_liste_en_cours = 1;
1093
      s/^\s*E\S+\s+//; s/\s+$//;
1094
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1095
    }
1096
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
1097
      $is_liste_en_cours = 0;
1098
    }
1099
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1100
      s/^\s+//; s/\s+$//;
1101
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1102
    }
1103
  }
1104
  close(Fher);
1105

    
1106

    
1107
  #dans le .lis (si il existe)
1108
  if(-e $flis) {
1109

    
1110
  open(Flis, "<$flis") or die "\nErreur (sub:lecture_mail_her) : impossible d ouvrir le fichier $flis ...\n\n";
1111
  $is_liste_en_cours = 0;
1112
  while(<Flis>) {
1113
    chomp;
1114
    if(/^\s*(N\S+)/) {
1115
      $nom_liste = $1;
1116
      $is_liste_en_cours = 1;
1117
      s/^\s*N\S+\s+//; s/\s+$//;
1118
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1119
    }
1120
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
1121
      $is_liste_en_cours = 0;
1122
    }
1123
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1124
      s/^\s+//; s/\s+$//;
1125
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1126
    }
1127
  }
1128
  close(Flis);
1129

    
1130
  open(Flis, "<$flis");
1131
  $is_liste_en_cours = 0;
1132
  while(<Flis>) {
1133
    chomp;
1134
    if(/^\s*(A\S+)/) {
1135
      $nom_liste = $1;
1136
      $is_liste_en_cours = 1;
1137
      s/^\s*A\S+\s+//; s/\s+$//;
1138
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1139
    }
1140
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
1141
      $is_liste_en_cours = 0;
1142
    }
1143
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1144
      s/^\s+//; s/\s+$//;
1145
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
1146
    }
1147
  }
1148
  close(Flis);
1149

    
1150
  open(Flis, "<$flis");
1151
  $is_liste_en_cours = 0;
1152
  while(<Flis>) {
1153
    chomp;
1154
    if(/^\s*(F\S+)/) {
1155
      $nom_liste = $1;
1156
      $is_liste_en_cours = 1;
1157
      s/^\s*F\S+\s+//; s/\s+$//;
1158
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1159
    }
1160
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
1161
      $is_liste_en_cours = 0;
1162
    }
1163
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1164
      s/^\s+//; s/\s+$//;
1165
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
1166
    }
1167
  }
1168
  close(Flis);
1169

    
1170
  open(Flis, "<$flis");
1171
  $is_liste_en_cours = 0;
1172
  while(<Flis>) {
1173
    chomp;
1174
    if(/^\s*(E\S+)/) {
1175
      $nom_liste = $1;
1176
      $is_liste_en_cours = 1;
1177
      s/^\s*E\S+\s+//; s/\s+$//;
1178
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1179
    }
1180
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
1181
      $is_liste_en_cours = 0;
1182
    }
1183
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
1184
      s/^\s+//; s/\s+$//;
1185
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
1186
    }
1187
  }
1188
  close(Flis);
1189

    
1190
  }#if(-e $flis)
1191

    
1192
  #AFFICHAGE DES LISTES DE NOEUDS
1193
  #foreach my $nom (keys(%listes_NOEUDS)) {
1194
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
1195
  #}
1196
  #AFFICHAGE DES LISTES D ARETES
1197
  #foreach my $nom (keys(%listes_ARETES)) {
1198
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
1199
  #}
1200
  #AFFICHAGE DES LISTES DE FACES
1201
  #foreach my $nom (keys(%listes_FACES)) {
1202
  #  print "$nom : @{$listes_FACES{$nom}}\n";
1203
  #}
1204
  #AFFICHAGE DES LISTES D ELEMENTS
1205
  #foreach my $nom (keys(%listes_ELEMENTS)) {
1206
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
1207
  #}
1208

    
1209
  return($nom_maillage, $nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
1210
         \%listes_NOEUDS, \%listes_ARETES,
1211
         \%listes_FACES, \%listes_ELEMENTS);
1212
}#sub lecture_mail_her
(3-3/24)
Redmine Appliance - Powered by TurnKey Linux