Projet

Général

Profil

perl script : convert Gmsh results into a .maple format » hz_gmsh2maple.pl

version 1.02 : amélioration de la robustesse pour déterminer les grandeurs disponibles dans un répertoire Gmsh - Julien Troufflard, 06/02/2023 15:10

 
1
#!/usr/bin/env perl
2
use strict;
3
use warnings;
4
use English;
5
use File::Glob qw(bsd_glob);
6
use File::Basename;
7
use IO::File;
8
use List::MoreUtils qw(uniq);
9
my $NOM_PROG = basename $PROGRAM_NAME;
10
#pattern d un reel pour les regex (desormais redondant avec $RE{num}{real} de Regexp::Common)
11
my $format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';
12

    
13

    
14
my $VERSION = '1.02';
15
#####################################################################################################
16
#  script pour visualiser un ou plusieurs maillages dans Gmsh                                       #
17
#  version 1.00 : version initiale (version testee sur : MacOSX Darwin)                             #
18
#  version 1.01 : modif majeure de la lecture des "no_maillage ref_noeud" pour chaque sortie        #
19
#                 (on fait plutot le choix de lire un ensemble de paires "no_maillage ref_noeud"    #
20
#                  sur la premiere ligne, puis la liste des grandeurs (avec ou sans STAT) sur la    #
21
#                  seconde ligne => permettra de gerer le cas ou on veut une sortie sur une zone    #
22
#                  qui concerne plusieurs maillages a la fois)                                      #
23
#  version 1.02 : amelioration de la reconnaissance des grandeurs disponibles dans un repertoire    #
24
#                 Gmsh (modif subroutine make_table_grandeurs_Gmsh() )                              #
25
#####################################################################################################
26

    
27

    
28

    
29
#
30
# note :
31
#     l une des difficultes du traitement est que la numerotation des noeuds dans le fichier Gmsh n est pas
32
#  la meme que les fichiers maillage .her dans le cas ou il y a plusieurs maillages.
33
#
34
#    On doit donc connaitre les maillages .her, et en particulier connaitre l ordre dans lequel ils ont ete
35
#  declares dans la sortie Gmsh (fichier .CVisu). En general, c est le meme ordre que dans le fichier .info du calcul.
36
#  La connaissance des fichiers maillages et de leur ordre permettra de se baser sur les listes de references
37
#  existantes pour ces maillages et de determiner la correspondance entre numero de noeud du fichier .her et 
38
#  numero de noeud qui lui correspond dans le fichier Gmsh .pos
39
#
40
#  Cette problematique est a l origine du choix de passer par un fichier de commande (voir aide du script).
41
#  De toute facon, il est egalement plus simple de passer par un fichier de commande pour definir les sorties (qui peuvent
42
#  etre nombreuses)
43
#
44

    
45

    
46

    
47

    
48

    
49

    
50

    
51
sub affichage_aide {
52
  use Text::Wrap;
53
  #config du package Text::Wrap
54
  $Text::Wrap::columns = 101;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1) dans le cas ou utilise wrap
55

    
56
  #indentation de longueur $NOM_PROG
57
  my $indent_NOM_PROG = ""; $indent_NOM_PROG .= " " for(1 .. length($NOM_PROG));
58

    
59
  print "----------------------------------------\n";
60
  print " script $NOM_PROG  (version $VERSION)\n";
61
  print "----------------------------------------\n";
62
  print "\n";
63
  print "But : convertir des donnees Gmsh (fichiers .pos) en fichier de type .maple\n";
64
  print "\n";
65
  print "Usage :\n";
66
  print wrap("  ","    $indent_NOM_PROG ", " $NOM_PROG [-h|help] [-v] [-l] [-trame nom_fic]\n", 
67
                                                     "rep_Gmsh fic_cmd fic_maple\n");
68
  print "\n";
69
  print "Arguments :\n";
70
  print "     o rep_Gmsh  : repertoire Gmsh\n";
71
  print "     o fic_cmd   : fichier de commande de sortie (voir \"Fonctionnement\")\n";
72
  print "     o fic_maple : fichier de type .maple a creer\n";
73
  print "\n";
74
  print "Fonctionnement :\n";
75
  print wrap("    ", "  ",
76
     "$NOM_PROG lit le fichier \"fic_cmd\" qui contient les mots-cles MAILLAGES et SORTIES. ",
77
   "Il produira le fichier \"fic_maple\" ",
78
   "qui contiendra un certain nombre de colonnes dans l ordre de ce qui est indique au mot-cle SORTIES.\n",
79
   "\n",
80
   "Le fichier \"fic_cmd\" aura la structure suivante :\n",
81
   "---------------------------------------------------------\n",
82
   "MAILLAGES #(mot-cle de declaration des maillages dans l ordre du .CVisu)\n",
83
   "nom_fichier #(fichier .her maillage 1)\n",
84
   "nom_fichier #(fichier .her maillage 2)\n",
85
   "...\n",
86
   "nom_fichier #(fichier .her maillage N)\n",
87
   "\n",
88
   "\n",
89
   "SORTIES #(mot-cle de declaration des grandeurs a sortir)\n",
90
   "\n",
91
   "#sortie 1\n",
92
   "no_mail_1 ref_n_1  no_mail_2 ref_n_2 ... #liste des no_maillage/ref_noeud\n",
93
   "[STAT ] var_1 var_2 ... var_N #liste des grandeurs voulues\n",
94
   "                              #(eventuellement precede du mot-cle STAT)\n",
95
   "#sortie 2\n",
96
   "no_mail_1 ref_n_1  no_mail_2 ref_n_2 ... #liste des no_maillage/ref_noeud\n",
97
   "[STAT ] var_1 var_2 ... var_N #liste des grandeurs voulues\n",
98
   "                              #(eventuellement precede du mot-cle STAT)\n",
99
   "...\n",
100
   "#sortie N\n",
101
   "no_mail_1 ref_n_1  no_mail_2 ref_n_2 ... #liste des no_maillage/ref_noeud\n",
102
   "[STAT ] var_1 var_2 ... var_N #liste des grandeurs voulues\n",
103
   "                              #(eventuellement precede du mot-cle STAT)\n",
104
   "---------------------------------------------------------\n",
105
   "\n",
106
   "L option -trame permet de generer un exemple de fichier de commande (voir Options).\n",
107
   "\n",
108
   "Le symbole \"#\" permet d ecrire des commentaires.\n", 
109
   "\n", 
110
   "Le mot-cle MAILLAGES permet de declarer les fichiers maillage (fichier .her). ",
111
   "Dans le cas a plusieurs maillages, il est tres important de les declarer dans le meme ordre que\n", 
112
   "celui dans le fichier .CVisu du calcul qui a cree le repertoire Gmsh.\n",
113
   "\n", 
114
   "Le mot-cle SORTIES permet de declarer les sorties. Une sortie est definie par un ensemble de paires \"no_maillage ref_noeud\" sur la premiere ligne. ",
115
   "Le numero de maillage (\"no_mail_...\") correspond a l ordre de declaration au mot-cle MAILLAGES. On indiquera comme reference ",
116
   "de noeud (\"ref_n_...\") soit un numero de noeud, soit une liste de reference de noeuds.\n",
117
   "  **remarque : une reference N_tout (tous les noeuds) est automatiquement generee pour chaque maillage\n",
118
   "               si elle n existe pas deja\n",
119
   "Sur une seconde ligne, on indique la liste de grandeurs (\"var_...\") a sortir. L option -l permet de connaitre les ",
120
   "grandeurs disponibles. Le mot-cle \"STAT\" permet d indiquer que l on souhaite une statistique (somme, moyenne, min, max) sur ",
121
   "l ensemble des noeuds plutot que les valeurs par noeud.\n"
122
  );
123
  print "\n";
124
  print "Options :\n";
125
  print "    -v : affichage du numero de version\n";
126
  print "\n";
127
  print "    -l : affichage des grandeurs disponibles dans le repertoire \"rep_Gmsh\"\n";
128
  print "         **NB : dans ce cas, on peut lancer le script de la maniere suivante :\n";
129
  print "                  > $NOM_PROG -l rep_Gmsh\n";
130
  print "\n";
131
  print "    -trame nom_fic : genere une trame de fichier de commande\n";
132
  print "                     **NB : dans ce cas, on peut lancer le script de la\n";
133
  print "                            maniere suivante :\n";
134
  print "                              > $NOM_PROG -trame nom_fic\n";
135
  print "\n";
136
  print "Auteur :\n";
137
  print "   TROUFFLARD Julien\n";
138
  print "       julien.troufflard\@free.fr\n";
139
  print "----------------------------------------\n";
140
}
141

    
142

    
143

    
144
#------------------------------------
145
#pas d arguments ou option -h ou -help => affichage de l aide et arret du programme
146
#------------------------------------
147
#cas sans argument
148
if($#ARGV == -1) {
149
  affichage_aide();
150
  exit;
151
}
152
# cas option -h/-help (rq : insensible a la casse)
153
foreach my $arg (@ARGV) {
154
  if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
155
    affichage_aide();
156
    exit;
157
  }
158
}
159

    
160
#------------------------------------
161
#option -v => affichage de la version et arret du programme
162
#------------------------------------
163
foreach my $arg (@ARGV) {
164
  if($arg eq '-v') {
165
    print "\n $NOM_PROG : version $VERSION\n\n";
166
    exit;
167
  }
168
}
169

    
170
#------------------------------------
171
#option -trame => creation du fichier de commande et arret du programme
172
#------------------------------------
173
for(my $i=0; $i<=$#ARGV; $i++) {
174
  if($ARGV[$i] eq '-trame') {
175
    defined($ARGV[$i+1]) or die "\n**Erreur (prog:$NOM_PROG,opt:-trame) : argument manquant (voir aide -h|-help)...\n\n";
176
    print_fic_cmd($ARGV[$i+1]);
177
    print "\nFichier cree : $ARGV[$i+1]\n\n";
178
    exit;
179
  }
180
}
181

    
182

    
183

    
184

    
185
#------------------------------------
186
#recuperation des arguments et options
187
#------------------------------------
188
my $rep_Gmsh;#repertoire Gmsh
189
my $fic_cmd;#fichier de commande
190
my $fic_maple_a_creer;#fichier de type .maple a creer
191

    
192
my $is_opt_l = 0;#indicateur de l option -l (affichage de la liste des grandeurs dispo dans le repertoire $rep_Gmsh)
193

    
194
#on parcourt la liste des arguments (on traite les options connues et on stocke les autres dans @args)
195
my $opt;
196
my @args;
197
while($#ARGV != -1) {
198
  $opt = shift(@ARGV);
199

    
200
  #option -l
201
  if($opt eq '-l') {
202
    $is_opt_l = 1;
203
  }
204

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

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

    
216

    
217

    
218
#recuperation des arguments obligatoires
219
#
220
#-on recupere d abord le repertoire Gmsh (pour appliquer directement une eventuelle option -l)
221
($#args >= 0) or die "\n**Erreur (prog:$NOM_PROG) : arguments manquants (voir aide : option -h ou -help)...\n\n";
222
$rep_Gmsh = shift(@args);
223
$rep_Gmsh =~ s/\/+$//;
224

    
225
#verif existence repertoire Gmsh
226
(-d $rep_Gmsh) or die "\n**Erreur (prog:$NOM_PROG) : repertoire Gmsh ($rep_Gmsh/) introuvable...\n\n";
227

    
228
#construction de la table des grandeurs et fichiers associes dans le repertoire Gmsh
229
my %table_grandeurs_rep_Gmsh;
230
#table de hashage : @{$table_grandeurs_rep_Gmsh{'liste_grandeurs'}} = (liste des noms de grandeur)
231
#
232
#                   $table_grandeurs_rep_Gmsh{nom grandeur}{'fichier'} = fichier .pos correspondant a la grandeur
233
#                   $table_grandeurs_rep_Gmsh{nom grandeur}{'nb_composantes'} = nombre de composantes de la grandeur
234
#
235
make_table_grandeurs_Gmsh($rep_Gmsh, \%table_grandeurs_rep_Gmsh);
236

    
237

    
238
#cas particulier : aucune grandeurs dispo
239
if($#{$table_grandeurs_rep_Gmsh{'liste_grandeurs'}} == -1) {
240
  die "\n**Erreur (prog:$NOM_PROG) : aucune grandeur n a ete trouve dans le repertoire Gmsh ($rep_Gmsh/) (plus precisement, aucun fichier d extension .pos n existe dans ce repertoire)...\n\n";
241
}
242

    
243

    
244

    
245
#option -l => affichage des grandeurs disponibles et sortie du programme
246
if($is_opt_l) {
247
  print "\n";
248
  print "--------------------------------------------------------------\n";
249
  print "Liste des grandeurs dans le repertoire $rep_Gmsh/ :\n";
250
  print "--------------------------------------------------------------\n";
251
  foreach my $grandeur (@{$table_grandeurs_rep_Gmsh{'liste_grandeurs'}}) {
252
    my $fpos = basename $table_grandeurs_rep_Gmsh{$grandeur}{'fichier'};
253
    print "  - $grandeur    ( fichier : $fpos )\n";
254
  }
255
  print "\n";
256
  exit;
257
}
258

    
259

    
260
#-on recupere le fichier de commande et le fichier .maple a creer
261
($#args >= 1) or die "\n**Erreur (prog:$NOM_PROG) : arguments manquants (voir aide : option -h ou -help)...\n\n";
262
$fic_cmd = shift(@args);
263
$fic_maple_a_creer = shift(@args);
264

    
265

    
266
#verif existence fichier commande
267
(-e $fic_cmd) or die "\n**Erreur (prog:$NOM_PROG) : fichier de commande ($fic_cmd) introuvable...\n\n";
268

    
269

    
270

    
271
#saisie des infos dans le fichier de commande
272
#
273
# - table des fichiers maillage
274
my %FHER;
275
#  table de hashage : $FHER{'nb_maillages'} = nombre de maillages
276
#
277
#                     $FHER{i}{'nb_noeuds'} = nombre de noeuds du maillage i
278
#                     $FHER{i}{'fichier'} = fichier .her du maillage i
279
#
280
$FHER{'nb_maillages'} = 0;
281

    
282

    
283
my $is_mot_cle_MAILLAGES_ok = 0;
284
my $is_mot_cle_SORTIES_ok = 0;
285

    
286
open(FIC, "<$fic_cmd");
287
my $nb_ligne_cmd = 0;
288
while(<FIC>) {
289
  $nb_ligne_cmd++;
290

    
291
  next if(/^\s*\#/);
292
  s/\s*#.*$//;
293
  next if(/^\s*$/);
294
  next if(not /^\s*MAILLAGES\s*$/);
295

    
296
  $is_mot_cle_MAILLAGES_ok = 1;
297

    
298
  while(<FIC>) {
299
    $nb_ligne_cmd++;
300

    
301
    next if(/^\s*\#/);
302
    s/\s*#.*$//;
303
    next if(/^\s*$/);
304
    if(/^\s*SORTIES\s*$/) {
305
      $is_mot_cle_SORTIES_ok = 1;
306
      last;
307
    }
308

    
309
    my ($fher) = split;
310
    my $nb_noeuds = nb_noeuds_maillage($fher);
311
    ($nb_noeuds > 0) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) le fichier de maillage $fher n est pas valide (impossible d y saisir le nombre de noeuds)...\n\n";
312
    $FHER{'nb_maillages'}++;
313
    $FHER{$FHER{'nb_maillages'}}{'fichier'} = $fher;
314
    $FHER{$FHER{'nb_maillages'}}{'nb_noeuds'} = $nb_noeuds;
315
  }
316
  last;
317
}
318

    
319
$is_mot_cle_MAILLAGES_ok or die "\n**Erreur (prog:$NOM_PROG) : le mot-cle MAILLAGES n a pas ete trouve dans le fichier $fic_cmd ...\n\n";
320
$is_mot_cle_SORTIES_ok or die "\n**Erreur (prog:$NOM_PROG) : le mot-cle SORTIES n a pas ete trouve dans le fichier $fic_cmd ...\n\n";
321

    
322

    
323
# - table des grandeurs a sortir
324
my %SORTIES;
325
# table de hashage : $SORTIES{'nb_sorties'} = nombre de commandes de sortie
326
#
327
#                    @{$SORTIES{i}{'no_maillage'}} = liste des numeros de maillage de la commande
328
#                    @{$SORTIES{i}{'ref_noeud'}} = liste des noeud ou nom de la liste de ref
329
#                    @{$SORTIES{i}{'no_maillage'}{'liste_noeuds_her'} = liste des noeuds numerotation .her par maillage
330
#                    @{$SORTIES{i}{'no_maillage'}{'liste_noeuds_Gmsh'} = liste des noeuds numerotation Gmsh par maillage
331
#                    @{$SORTIES{i}{'liste_grandeurs'}} = liste des grandeurs a sortir pour ce/ces noeud(s)
332
#
333
#                    $SORTIES{i}{'STAT'} : indicateur d une sortie de type STATISTIQUE
334
#
335
while(<FIC>) {
336
  $nb_ligne_cmd++;
337

    
338
  next if(/^\s*\#/);
339
  s/\s*#.*$//;
340
  next if(/^\s*$/);
341
  next if(not /^\s*(\d+)\s+/);
342

    
343
  @_ = split;
344
  (($#_+1) % 2 == 0) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) ligne non conforme (on doit y trouver des paires \"no_maillage  ref_noeud\")...\n\n";
345

    
346
  $SORTIES{'nb_sorties'}++;
347
  my $no_sortie = $SORTIES{'nb_sorties'};
348

    
349
  while($#_ != -1) {
350
    my $no_maillage = shift(@_);
351
    my $ref_noeud = shift(@_);
352

    
353
    ($no_maillage =~ /^\d+$/) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) la paire maillage/ref noeud ($no_maillage $ref_noeud) n est pas conforme (le no maillage n est pas un entier)...\n\n";
354
    ($ref_noeud =~ /^\d+$/ or $ref_noeud =~ /^N/) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) la paire maillage/ref noeud ($no_maillage $ref_noeud) n est pas conforme (ref noeud n est pas un entier ou une liste de reference de noeuds)...\n\n";
355

    
356
    push(@{$SORTIES{$no_sortie}{'no_maillage'}}, $no_maillage);
357
    push(@{$SORTIES{$no_sortie}{'ref_noeud'}}, $ref_noeud);
358
  }
359

    
360
  #verif maillage, existence ref noeud et remplissage des listes de noeuds (her et gmsh)
361
  for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
362
    my $no_maillage = $SORTIES{$no_sortie}{'no_maillage'}[$i];
363
    my $ref_noeud = $SORTIES{$no_sortie}{'ref_noeud'}[$i];
364

    
365
    #existence maillage
366
    ($no_maillage <= $FHER{'nb_maillages'}) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) le numero de maillage ($no_maillage) est plus grand que le nombre total de maillages ($FHER{'nb_maillages'}...\n\n";
367

    
368
    #-- cas d un numero de noeud
369
    if($ref_noeud =~ /^\d+$/) {
370
      ($ref_noeud <= $FHER{$no_maillage}{'nb_noeuds'}) or die "\n**Erreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) le noeud $ref_noeud n existe pas dans le maillage $no_maillage (fichier $FHER{$no_maillage}{'fichier'})...\n\n";
371
      @{$SORTIES{$no_sortie}{'liste_noeuds_her'}[$i]} = ($ref_noeud);
372
    }
373
    #-- cas d une liste de reference
374
    else {
375
      #lecture du maillage concerne
376
      my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her($FHER{$no_maillage}{'fichier'});
377
      #-on ajoute automatiquement la reference N_tout (tous les noeuds) si elle n existe pas
378
      if(not defined $ref_listes[0]->{'N_tout'}[0]) {
379
        push(@{$ref_listes[0]->{'N_tout'}}, 1 .. $nb_noeuds);
380
      }
381

    
382
      #verif existence reference
383
      (defined $ref_listes[0]->{$ref_noeud}[0]) or die "\nErreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) liste de reference $ref_noeud n existe pas dans le maillage $no_maillage (fichier $FHER{$no_maillage}{'fichier'})...\n\n";
384
      @{$SORTIES{$no_sortie}{'liste_noeuds_her'}[$i]} = @{$ref_listes[0]->{$ref_noeud}};
385
    }
386

    
387
    #conversion de la liste de noeuds en numerotation Gmsh
388
    # (on applique un decalage egal a la somme des noeuds des maillages precedant le maillage $no_maillage)
389
    my $decalage_no_noeud_Gmsh = 0;
390
    for(my $j=1; $j<=$no_maillage-1; $j++) {$decalage_no_noeud_Gmsh += $FHER{$j}{'nb_noeuds'};}
391
    foreach my $noeud_her (@{$SORTIES{$no_sortie}{'liste_noeuds_her'}[$i]}) {
392
      push(@{$SORTIES{$no_sortie}{'liste_noeuds_Gmsh'}[$i]}, $noeud_her + $decalage_no_noeud_Gmsh);
393
    }
394

    
395
  }
396

    
397
  while(<FIC>) {
398
    $nb_ligne_cmd++;
399

    
400
    next if(/^\s*\#/);
401
    s/\s*#.*$//;
402
    next if(/^\s*$/);
403
    next if(not /^\s*(STAT)?\s*\S+/);
404

    
405
    #on repere si une STATISTIQUE a ete demandee
406
    if(/^\s*STAT\s+/) {
407
      s/\s*STAT\s+//;
408
      $SORTIES{$SORTIES{'nb_sorties'}}{'STAT'} = 1;
409
    }
410

    
411
    my @grandeurs = split;
412
    
413
    #verif des grandeurs demandees
414
    foreach my $grandeur (@grandeurs) {
415
      (defined $table_grandeurs_rep_Gmsh{$grandeur}) or die "\nErreur (prog:$NOM_PROG) : (ligne $nb_ligne_cmd fichier $fic_cmd) grandeur $grandeur n existe pas dans le repertoire Gmsh $rep_Gmsh/ ...\n\n";
416
      push(@{$SORTIES{$no_sortie}{'liste_grandeurs'}}, $grandeur);
417
    }
418

    
419
    last;
420
  }#while(<FIC>)
421

    
422
}#while(<FIC>)
423
close(FIC);
424

    
425

    
426
($SORTIES{'nb_sorties'} > 0) or die "\nErreur (prog:$NOM_PROG) : aucune sortie n a ete trouve dans le fichier $fic_cmd ...\n\n";
427

    
428

    
429

    
430
#ecriture de l en-tete du fichier .maple
431
#
432
#
433
#
434
open(Fmaple, ">$fic_maple_a_creer");
435

    
436
print Fmaple "#------- script : $NOM_PROG (version $VERSION) -------\n";
437
print Fmaple "#\n";
438
print Fmaple "#fichier de commande : $fic_cmd\n";
439
print Fmaple "#repertoire Gmsh : $rep_Gmsh/\n";
440
print Fmaple "#\n";
441
print Fmaple "#--------------------------------------\n";
442
print Fmaple "#lien entre grandeur et fichier .pos\n";
443
print Fmaple "#--------------------------------------\n";
444
foreach my $grandeur (@{$table_grandeurs_rep_Gmsh{'liste_grandeurs'}}) {
445
  print Fmaple "#  - $grandeur   ==>  fichier : $table_grandeurs_rep_Gmsh{$grandeur}{'fichier'}\n";
446
}
447
print Fmaple "#\n";
448
print Fmaple "#----------------------------\n";
449
print Fmaple "#description des colonnes\n";
450
print Fmaple "#----------------------------\n";
451
print Fmaple "#\n";
452
my $nb_colonnes = 1;
453
print Fmaple "#[$nb_colonnes] temps\n";
454
print Fmaple "#\n";
455
for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++) {
456

    
457
  my @grandeurs = @{$SORTIES{$no_sortie}{'liste_grandeurs'}};
458
  my $is_STAT = 0; $is_STAT = 1 if(defined $SORTIES{$no_sortie}{'STAT'});
459

    
460
  print Fmaple "#\n";
461
  print Fmaple "#-- sortie $no_sortie --\n";
462
  print Fmaple "#  ----------------------------------\n";
463
  print Fmaple "#  > liste grandeurs : @grandeurs\n";
464
  print Fmaple "#     ==> STATISTIQUE (somme, moyenne, min, max)\n" if($is_STAT);
465
  print Fmaple "#  > listes noeuds  :\n";
466
  for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
467
    print Fmaple "#      - maillage : $FHER{$SORTIES{$no_sortie}{'no_maillage'}[$i]}{'fichier'} / liste noeuds : $SORTIES{$no_sortie}{'ref_noeud'}[$i]\n";
468
  }
469
  print Fmaple "#  ----------------------------------\n";
470

    
471
  #cas d une STATISTIQUE
472
  if($is_STAT) {
473
    print Fmaple "# STATISTIQUE :";
474
    foreach my $grandeur (@grandeurs) {
475
      print Fmaple " ";
476
      my $nb_comp = $table_grandeurs_rep_Gmsh{$grandeur}{'nb_composantes'};
477
      if($nb_comp == 1) {
478
        $nb_colonnes++;
479
        print Fmaple " [$nb_colonnes] $grandeur(SOMME)";
480
        $nb_colonnes++;
481
        print Fmaple " [$nb_colonnes] $grandeur(MOYENNE)";
482
        $nb_colonnes++;
483
        print Fmaple " [$nb_colonnes] $grandeur(MIN)";
484
        $nb_colonnes++;
485
        print Fmaple " [$nb_colonnes] $grandeur(MAX)";
486
      }
487
      else {
488
        for(my $i=1; $i<=$nb_comp; $i++) {
489
          $nb_colonnes++;
490
          print Fmaple " [$nb_colonnes] $grandeur(comp_$i, SOMME)";
491
          $nb_colonnes++;
492
          print Fmaple " [$nb_colonnes] $grandeur(comp_$i, MOYENNE)";
493
          $nb_colonnes++;
494
          print Fmaple " [$nb_colonnes] $grandeur(comp_$i, MIN)";
495
          $nb_colonnes++;
496
          print Fmaple " [$nb_colonnes] $grandeur(comp_$i, MAX)";
497

    
498
          print Fmaple "\n#             : " if($i != $nb_comp);
499
        }
500
      }
501
    }
502
    print Fmaple "\n";
503
  }
504

    
505
  #cas normal
506
  else {
507
    for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
508
      my @liste_noeuds_her = @{$SORTIES{$no_sortie}{'liste_noeuds_her'}[$i]};
509

    
510
      foreach my $no_noeud_her (@liste_noeuds_her) {
511
        print Fmaple "# noeud\_$no_noeud_her  :";
512
        foreach my $grandeur (@grandeurs) {
513
          print Fmaple " ";
514
          my $nb_comp = $table_grandeurs_rep_Gmsh{$grandeur}{'nb_composantes'};
515
          if($nb_comp == 1) {
516
            $nb_colonnes++;
517
            print Fmaple " [$nb_colonnes] $grandeur";
518
          }
519
          else {
520
            for(my $i=1; $i<=$nb_comp; $i++) {
521
              $nb_colonnes++;
522
              print Fmaple " [$nb_colonnes] $grandeur(comp_$i)";
523
            }
524
          }
525
        }
526
        print Fmaple "\n";
527
      }
528
    }
529
  }
530

    
531
}#for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++)
532

    
533
print Fmaple "#\n";
534
print Fmaple "#\n";
535
print Fmaple "\n";
536

    
537

    
538

    
539
#---------------------------
540
#ecriture des donnees
541
#---------------------------
542

    
543
#-d abord : saisie du temps (on se base sur le fichier .pos de la premiere grandeur de la table des grandeurs)
544
my @liste_temps;
545
$_ = $table_grandeurs_rep_Gmsh{'liste_grandeurs'}[0];
546
my $fic = $table_grandeurs_rep_Gmsh{$_}{'fichier'};
547
open(FIC, "<$fic");
548
while(<FIC>) {
549
  next if(not /^\s*\$nodedata\s*$/io);
550
  for(1 .. 3) {<FIC>;}
551
  $_ = <FIC>;
552
  my ($temps) = split;
553
  ($temps =~ /^$format_reel$/) or die "\nErreur (prog:$NOM_PROG) : temps non conforme ($temps) ligne $. du fichier $fic ...\n\n";
554
  push(@liste_temps, $temps);
555
}
556
close(FIC);
557

    
558

    
559

    
560
#-ensuite comme on va lire les fichiers nodedata par nodedata simultanement
561
# => on les ouvre tous via un hash de handle de fichiers
562
my %handle;
563
# => on cree la liste de noeuds (numerotation Gmsh) concernes pour chaque grandeur parmi toutes les sorties
564
my %liste_noeuds_Gmsh_grandeur;# @{$liste_noeuds_Gmsh_grandeur{nom grandeur}} = (liste de noeuds triee ordre croissant)
565
# => on creera un hash de valeur que l on rangera correctement dans l ordre des colonnes prevu
566
my %hash_valeurs;# $hash_valeurs{no noeud Gmsh}{grandeur}{no composante} = valeur
567
#                    (NB : no noeud Gmsh vient de la liste @{$SORTIES{no_sortie}{'liste_noeuds_Gmsh'})
568

    
569
#creation du handle de fichier pour chaque grandeur demandee
570
my %table_tmp_grandeurs_demandees;
571
my @liste_grandeurs_demandees;
572
my %handle_line_number;#  (NB : hash permettant de connaitre la ligne courante de chaque fichier pour plus tard)
573
for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++) {
574
  foreach my $grandeur (@{$SORTIES{$no_sortie}{'liste_grandeurs'}}) {
575
    if(not defined $table_tmp_grandeurs_demandees{$grandeur}) {
576
      $table_tmp_grandeurs_demandees{$grandeur} = 1;
577
      push(@liste_grandeurs_demandees, $grandeur);
578
      $handle{$grandeur} = IO::File->new();
579
      $handle{$grandeur}->open("<$table_grandeurs_rep_Gmsh{$grandeur}{'fichier'}");
580
      $handle_line_number{$grandeur} = 0;
581
    }
582
  }
583
}
584

    
585
#liste de noeuds (numerotation Gmsh) concernes pour chaque grandeur parmi toutes les sorties
586
for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++) {
587
  my @grandeurs = @{$SORTIES{$no_sortie}{'liste_grandeurs'}};
588

    
589
  for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
590
    my @liste_noeuds_Gmsh = @{$SORTIES{$no_sortie}{'liste_noeuds_Gmsh'}[$i]};
591

    
592
    foreach my $grandeur (@grandeurs) {
593
      push(@{$liste_noeuds_Gmsh_grandeur{$grandeur}}, @liste_noeuds_Gmsh);
594
    }
595
  }
596
}
597
#tri ordre croissant et suppression des doublons eventuels
598
foreach my $grandeur (@liste_grandeurs_demandees) {
599
  @{$liste_noeuds_Gmsh_grandeur{$grandeur}} = sort {$a <=> $b} @{$liste_noeuds_Gmsh_grandeur{$grandeur}};
600
  @{$liste_noeuds_Gmsh_grandeur{$grandeur}} = uniq @{$liste_noeuds_Gmsh_grandeur{$grandeur}};
601
}
602

    
603

    
604
#debut de la lecture
605
foreach my $temps (@liste_temps) {
606

    
607
  #positionnement de tous les fichiers sur le prochain $nodedata (et verif du temps)
608
  #  plus exactement : on se positionnera juste avant le debut des valeurs noeud composantes... du nodedata
609
  foreach my $grandeur (@liste_grandeurs_demandees) { 
610
    while($_ = $handle{$grandeur}->getline) {
611
      $handle_line_number{$grandeur}++;
612
      last if(/^\s*\$nodedata\s*$/io);
613
    }
614
    #verif temps
615
    for(1 .. 3) {$handle{$grandeur}->getline; $handle_line_number{$grandeur}++;}
616
    $_ = $handle{$grandeur}->getline; $handle_line_number{$grandeur}++;
617
    my ($temps_) = split;
618
    ($temps_ = $temps) or die "\nErreur (prog:$NOM_PROG) : temps non conforme ($temps) ligne $handle_line_number{$grandeur} du fichier $table_grandeurs_rep_Gmsh{$grandeur}{'fichier'} ...\n\n";
619
    #positionnement final juste avant le debut des valeurs du nodedata
620
    for(1 .. 4) {$handle{$grandeur}->getline; $handle_line_number{$grandeur}++;}
621
  }
622

    
623

    
624
  #parcours de chaque grandeur
625
  #pour l instant on parcours les noeuds de chaque sortie dans l ordre croissant et dans la numerotation Gmsh
626
  #==> remplissage de $hash_valeurs{no noeud Gmsh}{grandeur}{no composante}
627
  foreach my $grandeur (@liste_grandeurs_demandees) {
628
    foreach my $no_noeud_Gmsh (@{$liste_noeuds_Gmsh_grandeur{$grandeur}}) {
629
      while($_ = $handle{$grandeur}->getline) {
630
        $handle_line_number{$grandeur}++;
631
        @_ = split;
632
        next if($_[0] != $no_noeud_Gmsh);
633

    
634
        for(my $no_comp=1; $no_comp<=$#_; $no_comp++) {
635
          $hash_valeurs{$no_noeud_Gmsh}{$grandeur}{$no_comp} = $_[$no_comp];
636
        }
637
        last;
638
      }
639
    }
640
  }
641

    
642
  #parcours de chaque sortie dans le meme ordre que l en-tete afin d ecrire les colonnes dans le bon ordre
643
  #-ecriture du temps
644
  print Fmaple "$temps";
645

    
646
  #-ecriture des grandeurs pour chaque sortie
647
  for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++) {
648

    
649
    my @grandeurs = @{$SORTIES{$no_sortie}{'liste_grandeurs'}};
650
    my $is_STAT = 0; $is_STAT = 1 if(defined $SORTIES{$no_sortie}{'STAT'});
651

    
652
    #cas d une STATISTIQUE
653
    if($is_STAT) {
654
      foreach my $grandeur (@grandeurs) {
655

    
656
        my $nb_comp = $table_grandeurs_rep_Gmsh{$grandeur}{'nb_composantes'};
657

    
658
        if($nb_comp == 1) {
659
          my $somme = 0.;
660
          my $moyenne;
661
          my ($min,$max);
662
          my $nb_val = 0;
663
          for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
664
            my @liste_noeuds_Gmsh = @{$SORTIES{$no_sortie}{'liste_noeuds_Gmsh'}[$i]};
665
            $nb_val += $#liste_noeuds_Gmsh + 1;
666

    
667
            foreach my $no_noeud_Gmsh (@liste_noeuds_Gmsh) {
668
              my $val = $hash_valeurs{$no_noeud_Gmsh}{$grandeur}{1};
669
              $somme += $val;
670
              $min = $max = $val if(not defined $min);
671
              $min = $val if($val < $min);
672
              $max = $val if($val > $max);
673
            }
674
          }
675
          $moyenne = $somme/$nb_val;
676
          print Fmaple " $somme $moyenne $min $max";
677
        }
678
        else {
679
          for(my $i=1; $i<=$nb_comp; $i++) {
680
            my $somme = 0.;
681
            my $moyenne;
682
            my ($min,$max);
683
            my $nb_val = 0;
684
            for(my $j=0; $j<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $j++) {
685
              my @liste_noeuds_Gmsh = @{$SORTIES{$no_sortie}{'liste_noeuds_Gmsh'}[$j]};
686
              $nb_val += $#liste_noeuds_Gmsh + 1;
687

    
688
              foreach my $no_noeud_Gmsh (@liste_noeuds_Gmsh) {
689
                my $val = $hash_valeurs{$no_noeud_Gmsh}{$grandeur}{$i};
690
                $somme += $val;
691
                $min = $max = $val if(not defined $min);
692
                $min = $val if($val < $min);
693
                $max = $val if($val > $max);
694
              }
695
            }
696
            $moyenne = $somme/$nb_val;
697
            print Fmaple " $somme $moyenne $min $max";
698
          }#for(my $i=1; $i<=$nb_comp; $i++)
699
        }#else
700
      }#foreach my $grandeur (@grandeurs)
701
    }#if($is_STAT)
702

    
703
    #cas normal
704
    else {
705
      for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++) {
706
        my @liste_noeuds_Gmsh = @{$SORTIES{$no_sortie}{'liste_noeuds_Gmsh'}[$i]};
707

    
708
        foreach my $no_noeud_Gmsh (@liste_noeuds_Gmsh) {
709
          foreach my $grandeur (@grandeurs) {
710
            my $nb_comp = $table_grandeurs_rep_Gmsh{$grandeur}{'nb_composantes'};
711
            if($nb_comp == 1) {
712
              print Fmaple " $hash_valeurs{$no_noeud_Gmsh}{$grandeur}{1}";
713
            }
714
            else {
715
              for(my $j=1; $j<=$nb_comp; $j++) {
716
                print Fmaple " $hash_valeurs{$no_noeud_Gmsh}{$grandeur}{$j}";
717
              }
718
            }
719
          }#foreach my $grandeur (@grandeurs)
720
        }#foreach my $no_noeud_Gmsh (@liste_noeuds_Gmsh)
721
      }#for(my $i=0; $i<=$#{$SORTIES{$no_sortie}{'no_maillage'}}; $i++)
722
    }#else
723
  }#for(my $no_sortie=1; $no_sortie<=$SORTIES{'nb_sorties'}; $no_sortie++)
724
  print Fmaple "\n";
725

    
726

    
727
}#foreach my $temps (@liste_temps)
728

    
729

    
730

    
731
close(Fmaple);
732

    
733
#fermeture des fichiers .pos
734
foreach my $grandeur (@liste_grandeurs_demandees) {
735
  close($handle{$grandeur});
736
}
737

    
738
print "\nFichier cree : $fic_maple_a_creer\n\n";
739

    
740

    
741

    
742

    
743

    
744
#----------------
745
#subroutine make_table_grandeurs_Gmsh
746
#
747
#  construction de la table de hashage des grandeurs d un repertoire Gmsh
748
#
749
#  entree :
750
#    - repertoire Gmsh
751
#    - reference vers la table de hashage des grandeurs du repertoire Gmsh
752
#
753
sub make_table_grandeurs_Gmsh {
754
  my $rep_Gmsh = shift;
755
  my $ref_table_grandeurs = shift;
756

    
757
  my @fpos;
758
  foreach my $fichier (bsd_glob("$rep_Gmsh/*_Gmsh.pos")) {
759
    (-T $fichier) or next;
760
    is_fic_pos_valide($fichier) or next;
761

    
762
    my $fichier_bn = basename $fichier;
763
    push(@fpos, $fichier_bn);
764
  }
765

    
766
  ###inutile depuis version 1.02 => my $racine_commune = chaine_commune(@fpos);
767

    
768
  foreach my $fpos (@fpos) {
769
    my $grandeur = get_nom_grandeur_fpos("$rep_Gmsh/$fpos");
770

    
771
    #cas ou cette grandeur a deja ete trouve => on ne peut pas avoir 2 fichiers .pos de meme grandeur
772
    if(defined $ref_table_grandeurs->{$grandeur}{'fichier'}) {
773
      die "\nErreur (prog:$NOM_PROG) : (subroutine make_table_grandeurs_Gmsh) la grandeur $grandeur correspond a 2 fichiers .pos differents :\
774
         - fichier 1 : $ref_table_grandeurs->{$grandeur}{'fichier'}\
775
         - fichier 2 : $rep_Gmsh/$fpos\
776
         ===> effacer l un des fichiers sinon le programme $NOM_PROG ne peut fonctionner...\n\n";
777
    }
778

    
779
    $ref_table_grandeurs->{$grandeur}{'fichier'} = "$rep_Gmsh/$fpos";
780
    $ref_table_grandeurs->{$grandeur}{'nb_composantes'} = get_nb_comp_fpos("$rep_Gmsh/$fpos");
781

    
782
    push(@{$ref_table_grandeurs->{'liste_grandeurs'}}, $grandeur);
783
  }
784

    
785
}#sub make_table_grandeurs_Gmsh
786
#----------------
787

    
788

    
789
#----------------
790
#subroutine get_nom_grandeur_fpos
791
#
792
# lit le nom de la grandeur liee a un fichier .pos
793
#(lecture du nom de grandeur du premier nodedata trouve dans le fichier)
794
#
795
#  entree :
796
#    - fichier .pos
797
#
798
#  sortie :
799
#    - nom grandeur
800
#
801
sub get_nom_grandeur_fpos {
802
  my $fpos = shift;
803

    
804
  my $nom_grandeur;
805
  open(my $Hlocal, "<$fpos");
806
  while(<$Hlocal>) {
807
    next if(not /^\s*\$nodedata\s*$/io);
808
    <$Hlocal>;
809
    $_ = <$Hlocal>;
810
    ($nom_grandeur) = split;
811
    $nom_grandeur =~ s/^[\"\']+//;
812
    $nom_grandeur =~ s/[\"\']+$//;
813
    last;
814
  }
815
  close($Hlocal);
816

    
817
  defined($nom_grandeur) or die "\nErreur (prog:$NOM_PROG) : (subroutine get_nom_grandeur_fpos) impossible de trouver le nom de grandeur dans le fichier $fpos ...\n\n";
818

    
819
  return $nom_grandeur;
820
}#sub get_nom_grandeur_fpos
821
#----------------
822

    
823

    
824
#----------------
825
#subroutine get_nb_comp_fpos
826
#
827
#  saisie du nombre de composantes d une grandeur dans un fichier Gmsh .pos
828
#
829
#  entree :
830
#    - nom fichier .pos
831
#
832
#  sortie :
833
#    - nombre de composantes
834
#
835
sub get_nb_comp_fpos {
836
  my $fpos = shift;
837

    
838
  open(my $Hlocal, "<$fpos");
839
  while(<$Hlocal>) {
840
    next if(not /^\s*\$nodedata\s*$/io);
841
    for(1 .. 6) {<$Hlocal>;}
842
    $_ = <$Hlocal>;
843
    my ($nb_comp) = split;
844
    ($nb_comp =~ /^\d+$/) or die "\nErreur (prog:$NOM_PROG) : impossible de lire le nombre de composantes dans le fichier $fpos ...\n\n";
845
    close($Hlocal);
846
    return $nb_comp;
847
  }
848
  close($Hlocal);
849

    
850
  die "\nErreur (prog:$NOM_PROG) : impossible de lire le nombre de composantes dans le fichier $fpos ...\n\n";
851
}#sub get_nb_comp_fpos
852
#----------------
853

    
854

    
855

    
856
#----------------
857
#subroutine print_fic_cmd
858
#
859
#  ecriture d un fichier exemple de commande
860
#
861
#  entree :
862
#    - nom fichier a creer
863
sub print_fic_cmd {
864
  my $fic_cmd = shift;
865

    
866
  open(my $Hlocal, ">$fic_cmd");
867
  print $Hlocal 'MAILLAGES #mot-cle de declaration des fichiers maillage
868
nom_fichier_1.her
869
nom_fichier_2.her
870

    
871

    
872
SORTIES #mot-cle de declaration des sorties de grandeurs
873

    
874
#sortie des grandeurs EPS11 et SIG11
875
# pour les noeuds de la liste N_tout du maillage 1 
876
1 N_tout
877
EPS11 SIG11
878

    
879
#sortie des grandeurs Def_principaleI et Sigma_principaleI
880
# pour le noeud 129 du maillage 2
881
2 129
882
Def_principaleI Sigma_principaleI
883

    
884
#sortie des grandeurs def_duale_mises et contrainte_mises
885
# pour les noeuds de la liste N_S du maillage 1 
886
1 N_S
887
def_duale_mises contrainte_mises
888

    
889
#sortie des grandeurs def_duale_mises et contrainte_mises
890
# statistiques sur les valeurs aux noeuds de la liste N_S du maillage 1 
891
1 N_S
892
STAT  def_duale_mises contrainte_mises
893

    
894
#sortie de la grandeur deplace
895
# statistiques sur les valeurs aux noeuds de la liste N_E du maillage 1 
896
# et de la liste N_O du maillage 2
897
1 N_E  2 N_O
898
STAT   deplace
899
';
900

    
901
  close($Hlocal);
902
}#sub print_fic_cmd
903
#----------------
904

    
905

    
906
#----------------
907
#subroutine is_fic_pos_valide
908
#
909
#  verification rapide de la valide d un fichier .pos (par une heuristique : presence du mot-cle $nodedata au moins une fois)
910
#
911
#  entree :
912
#    - nom fichier a verifier
913
#
914
#  sortie :
915
#    - indicateur (1 si fichier valide, sinon 0)
916
#
917
sub is_fic_pos_valide {
918
  my $fic = shift;
919

    
920
  open(my $Hlocal, "<$fic");
921
  while(<$Hlocal>) {
922
    next if(not /^\s*\$nodedata\s*$/io);
923
    close($Hlocal);
924
    return 1;
925
  }
926
  close($Hlocal);
927

    
928
  return 0;
929
}#sub is_fic_pos_valide
930

    
931

    
932
#----------------
933
#subroutine nb_noeuds_maillage
934
#
935
#  renvoie le nombre de noeuds si le fichier est un maillage .her valide (par une heuristique sur NOEUDS)
936
#  sinon 0
937
#
938
#  entree :
939
#    - nom fichier
940
#
941
#  sortie :
942
#    - nombre de noeuds (ou 0 si le maillage n est pas valide)
943
sub nb_noeuds_maillage {
944
  my $fher = shift;
945

    
946
  my $nb_noeuds = 0;
947

    
948
  open(my $Hlocal, "<$fher");
949
  while(<$Hlocal>) {
950
    next if(not /^\s*(\d+)\s+NOEUDS/o);
951
    $nb_noeuds = $1;
952
    last;
953
  }
954
  close($Hlocal);
955

    
956
  return $nb_noeuds;
957
}#sub nb_noeuds_maillage
958

    
959

    
960
#----------------
961
#subroutine chaine_commune
962
#
963
#  determine la chaine de caracteres commune a une liste de chaine de caractere (en commencant par le debut des chaines)
964
#
965
#  entree :
966
#    - liste de chaines de caracteres
967
#
968
#  sortie :
969
#    - chaine commune
970
#
971
sub chaine_commune {
972
  my @liste = @_;
973

    
974
  return '' if($#liste == -1);
975

    
976
  my $chaine_commune = '';
977
  MAIN:while(length($liste[0]) > 0) {
978
    $liste[0] =~ s/^(.)//;
979
    my $lettre_commune = $1;
980
    for(my $i=1; $i<=$#liste; $i++) {
981
      last MAIN if(length($liste[$i]) == 0);
982
      $liste[$i] =~ s/^(.)//;
983
      my $lettre = $1;
984
      last MAIN if($lettre ne $lettre_commune);
985
    }
986
    $chaine_commune .= $lettre_commune;
987
  }
988

    
989
  return $chaine_commune;
990
}#sub chaine_commune
991

    
992

    
993

    
994
#----------------
995
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
996
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
997
#
998
# exemple d appel :
999
#  my ($nom_maillage, $nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her");
1000
#
1001
#  avec - $nom_maillage     : nom du maillage (si il y en a un. sinon $nom_maillage sera egal a undef
1002
#       - $nb_noeuds        : nombre de noeuds (entier)
1003
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
1004
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
1005
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
1006
#       - $nb_elts          : nombre d elements (entier)
1007
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
1008
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
1009
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
1010
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
1011
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
1012
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
1013
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
1014
#                                $ref_listes[4] : reference vers la table de hashage des listes de points d integration => @{$ref_listes[4]->{'nom liste'}} : (liste des points d integration)
1015
#                                
1016
sub lecture_mail_her {
1017
  my $fher = shift;
1018

    
1019
  my $nom_maillage;
1020

    
1021
  #------------------------
1022
  # lecture du maillage .her
1023
  #------------------------
1024
  #-lecture de noeuds
1025
  my @tab_noeuds; my $nb_noeuds;
1026
  my $no_noeud = 0;
1027
  open(Fher, "<$fher");
1028
  while(<Fher>) {
1029
    if(/^\s*nom_maillage\s+(\S+)/o) {$nom_maillage = $1; next;}
1030
    next if(not /(\d+)\s+NOEUDS/o);
1031
    $nb_noeuds = $1;
1032
    last;
1033
  }
1034
  while(<Fher>) {
1035
    last if($no_noeud == $nb_noeuds);
1036
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/o);
1037
    $no_noeud = $1;
1038
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
1039
  }
1040

    
1041
  #-lecture des elements
1042
  my %tab_elements; my $nb_elts;
1043
  my $no_elt = 0;
1044
  while(<Fher>) {
1045
    next if(not /(\d+)\s+ELEMENTS/o);
1046
    $nb_elts = $1;
1047
    last;
1048
  }
1049
  while(<Fher>) {
1050
    last if($no_elt == $nb_elts);
1051
    next if(not /^\s*\d+\s+\w+\s+\w+/o);
1052
    s/^\s+//;s/\s+$//;
1053
    $_ =~ /^(\d+)\s+/;
1054
    $no_elt = $1; s/^(\d+)\s+//;
1055
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
1056
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
1057
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
1058
  }
1059
  close(Fher);
1060

    
1061

    
1062
  #------------------------
1063
  # lecture des references (dans le .her et dans un eventuel .lis)
1064
  #------------------------
1065
  my $flis = $fher; $flis =~ s/.her$/.lis/;
1066
  my $nom_liste;
1067
  my $is_liste_en_cours;
1068
  my %listes_NOEUDS;
1069
  my %listes_ARETES;
1070
  my %listes_FACES;
1071
  my %listes_ELEMENTS;
1072
  my %listes_PTI;
1073

    
1074
  #-dans le .her
1075
  open(Fher, "<$fher");
1076
  $is_liste_en_cours = 0;
1077
  while(<Fher>) {
1078
    chomp;
1079
    if(/^\s*(N\S+)/o) {
1080
      $nom_liste = $1;
1081
      $is_liste_en_cours = 1;
1082
      s/^\s*N\S+\s+//; s/\s+$//;
1083
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1084
    }
1085
    elsif(/^\s*noeuds/io or /^\s*elements/i or /^\s*[AFEG]/o) {
1086
      $is_liste_en_cours = 0;
1087
    }
1088
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/io) {
1089
      s/^\s+//; s/\s+$//;
1090
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
1091
    }
1092
  }
1093
  close(Fher);
1094

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

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

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

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

    
1175

    
1176
  #dans le .lis (si il existe)
1177
  if(-e $flis) {
1178

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

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

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

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

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

    
1279
  }#if(-e $flis)
1280

    
1281
  #AFFICHAGE DES LISTES DE NOEUDS
1282
  #foreach my $nom (keys(%listes_NOEUDS)) {
1283
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
1284
  #}
1285
  #AFFICHAGE DES LISTES D ARETES
1286
  #foreach my $nom (keys(%listes_ARETES)) {
1287
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
1288
  #}
1289
  #AFFICHAGE DES LISTES DE FACES
1290
  #foreach my $nom (keys(%listes_FACES)) {
1291
  #  print "$nom : @{$listes_FACES{$nom}}\n";
1292
  #}
1293
  #AFFICHAGE DES LISTES D ELEMENTS
1294
  #foreach my $nom (keys(%listes_ELEMENTS)) {
1295
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
1296
  #}
1297
  #AFFICHAGE DES LISTES DE POINTS D INTEGRATION
1298
  #foreach my $nom (keys(%listes_PTI)) {
1299
  #  print "$nom : @{$listes_PTI{$nom}}\n";
1300
  #}
1301

    
1302
  return($nom_maillage, $nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
1303
         \%listes_NOEUDS, \%listes_ARETES,
1304
         \%listes_FACES, \%listes_ELEMENTS, \%listes_PTI);
1305
}#sub lecture_mail_her
(5-5/6)
Redmine Appliance - Powered by TurnKey Linux