améliorer performance script

**Philou67430** · 02/10/2015, 08h49

Envoyé par seagull

non, on pourrait remplacer $format_reel par \S+. J'ai mis $format_reel par habitude mais ça sert à rien. La structure d'un NodeData est toujours la même comme cet exemple :
$NodeData
1 => nombre de lignes d'information qui vont suivre (en l'occurence 1 seule => "deplace")
"deplace" => la fameuse ligne annoncée
1 => nombre de lignes d'information qui vont suivre (en l'occurence 1 seule => un réel qui est le temps)
0.001 => le fameux réel annoncé
3 => nombre de lignes d'information qui vont suivre (en l'occurence 3 => les 2 premières je ne sais plus mais la 3ème est le nombre de noeuds)
1
3
3362 => le nombre de noeuds
1 x y z
2 x y z
.
.
3362 x y z

Donc pour la ligne "le fameux réel annoncé", on pourrait "prendre la ligne" sans autre forme de procès (et ne pas contrôler qu'il s'agit bien d'un réel, c'est ça ? (ça évite d'extraire le réel avec une regexp, alors qu'un simple chomp suffit).
Idem pour x, y, z (que j'ai déjà remplacé par un split /\s+/

**Philou67430** · 02/10/2015, 09h46

La version 8 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
#!/usr/bin/perl
#!/usr/local/bin/perl
use strict;
use warnings;
use English;
use File::Basename;
use Text::Wrap;
 
## HISTORY
## 01 - Etapes mises en fonctions (pour profiling)
## 02 - OPTIM 1: compiler les regexp.
## 03 - OPTIM 2: lecture fichier fgmsh_dpl dans une fonction
## 04 - OPTIM 3: lecture fichier fgmsh_dpl pour "n" noeuds au lieu d'un seul (un seul lu à la fois)
## 05 - OPTIM 4: lecture fichier fgmsh_dpl pour "n" noeuds au lieu d'un seul (tous lus en une fois)
## 06 - OPTIM 5: split au lieu de regexp pour l'extraction des infos d'une ligne de noeud dans les donnes de noeud
##               option verbose pour ne pas afficher les "verification deplacements ..."
## 07 - OPTIM 6: suppression des paramètres inutiles entre etape 4 et 5
##               read_dpl : eviter de stocker le temps dans les données de noeud (déjà stocké dans un tableau)
## 08 - OPTIM 7: suppression de l'utilisation des fichiers temporaires
## TODO : traitement par lot en tenant compte de la mémoire consommée.
 
$Text::Wrap::columns = 81;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1)
my $NOM_PROG = basename $PROGRAM_NAME;
#pattern d un reel pour les regex (pourrait etre remplacee par $RE{num}{real} du package Regexp::Common)
my $format_reel = qr/[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?/;
my $verbose = 0;
 
#########################################################################################################################
#
# resume des etapes :
#   ETAPE 0 => recuperation des arguments, affichage eventuel de l aide, etc... (rien a signaler => etape rapide)
#   ETAPE 1 => lecture des 2 maillages (rien a signaler => etape rapide)
#   ETAPE 2 => determination des noeuds communs aux 2 maillages (rien a signaler => etape rapide)
#   ETAPE 3 => verification du fichier fdpl_1 contenant les deplacements (etape un peu longue mais sans plus)
#   ETAPE 4 => ecriture de plein fichiers temporaires que l on concatene ensuite un seul fichier (ETAPE TRES LONGUE!!!!!!!!!)
#   ETAPE 5 => ecriture de quelques fichiers supplementaires (rien a signaler => etape rapide)
#
#########################################################################################################################
 
sub etape0();sub etape1(%); sub etape2(%); sub etape3(%); sub etape4(%); sub etape5(%);
my %opt = etape0();
%opt = (%opt, etape1(%opt));
%opt = (%opt, etape2(%opt));
%opt = (%opt, etape3(%opt));
%opt = (%opt, etape4(%opt));
etape5(%opt);
 
#########################################################################################################################
#
# ETAPE 0
#
#   recuperation des arguments, affichage eventuel de l aide, etc...
#
#   rien a dire sauf qu un jour, il faudra vraiment que je regarde le package getopt
#   bref...
#
#########################################################################################################################
sub etape0() {
 
  #premier balyage des arguments pour reperer une demande d affichage de l aide
  # => si option du style -h ou -help => affichage aide
  my $isOpt_help = 0;
  foreach my $arg (@ARGV) {
    if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
      $isOpt_help = 1;
    }
  }
 
  #si option -h|-help ou pas d arguments => affichage aide
  if($isOpt_help or ($#ARGV < 3)) {
    my $indent = "    "; $indent .= " " for(1 .. length($NOM_PROG));
    print "\n";
    print "--------------------------------------------------------------------------------\n";
    print wrap("",$indent,
               " $NOM_PROG - saisir les deplacements Gmsh issus d un calcul sur un maillage 1 et appliquer ces deplacements sur un maillage 2 aux noeuds communs entre les 2 maillages\n");
    print "--------------------------------------------------------------------------------\n";
    print "\n";
    print "  USAGE :\n";
    print "    $NOM_PROG [-h|help] [-prec PREC] fher_1 fdpl_1 fher_2 racine_fic_calcul\n";
    print "\n";
    print "  ARGUMENTS :\n";
    print "    fher_1 : fichier maillage 1 (.her)\n";
    print "    fdpl_1 : fichier resultat Gmsh contenant la grandeur \"deplace\"\n";
    print "    fher_2 : fichier maillage 2 (.her)\n";
    print "    racine_fic_calcul : chaine de caracteres utilisee pour nommer les\n";
    print "                        fichiers suivants qui vont etre crees :\n";
    print "                          - racine_fic_calcul.courbes => courbe temps-deplacement par noeud\n";
    print "                          - racine_fic_calcul.lis     => listes de references par noeud\n";
    print "                          - racine_fic_calcul.cl      => conditions de blocage\n";
    print "                          - racine_fic_calcul.TYPE5   => chargement global de TYPE5\n";
    print "                                                         (voir doc herezh : typecharge)\n";
    print "\n";
    print "  OPTIONS :\n";
    print "    -prec PREC : changer la precision sur les coordonnes des noeuds pour rechercher\n";
    print "                 les noeuds communs entre maillage fher_1 et fher_2 (par defaut : 1e-6)\n";
    print "\n";
    print "  REMARQUE :\n";
    print "    Seuls les noeuds du maillage fher_2 qui sont communs avec ceux du maillage fher_1\n";
    print "    auront des conditions de deplacements imposes. Les autres noeuds seront libres.\n";
    print "\n";
    print "  CONSEILS D UTILISATION DES FICHIERS racine_fic_calcul.* :\n";
    print "    Les fichiers crees peuvent etre inseres tels quel dans un .info via des includes \'<\'.\n";
    print "    1) Dans la partie maillage, le fichier racine_fic_calcul.lis peut etre mis a\n";
    print "    la suite de la declaration du maillage :\n";
    print "      < fher_2(.her)\n";
    print "      < fher_2(.lis)\n";
    print "      < racine_fic_calcul.lis\n";
    print "\n";
    print "    2) le fichier racine_fic_calcul.courbes est a inserer au niveau \'les_courbes_1D\'\n";
    print "    3) le fichier racine_fic_calcul.cl est a inserer au niveau \'blocages\'\n";
    print "    4) le fichier racine_fic_calcul.TYPE5 est a inserer au niveau \'typecharge\' si\n";
    print "       on souhaite obtenir un calcul exactement aux memes instants que le calcul de\n";
    print "       reference. Dans ce cas, verifier que les parametres de \'controle\' DELTAtMINI\n";
    print "       et DELTAtMAXI permettent de respecter ces temps (on peut mettre\n";
    print "       DELTAtMINI=1.e-90 et DELTAtMAXI = 1.e+90 et laisser herezh gerer)\n";
    print "\n";
    print "--------------------------------------------------------------------------------\n";
    print "\n";
    exit;
  }
 
  #- - - - - - - - - - - - - - - - - - -
  # gestion des options
  #- - - - - - - - - - - - - - - - - - -
  #precision pour la recherche des noeuds confondus (1.e-6 par defaut, modifiable avec option -prec)
  my $PREC = 1e-6;
 
  my $opt;
  my @args;
  while($#ARGV > -1) {
    $opt = shift(@ARGV);
 
    if($opt eq '-prec') {
      $PREC = shift(@ARGV); ($PREC =~ /^$format_reel$/ and $PREC > 0) or die "\nErreur (prog:$NOM_PROG, option: -prec) : la precision ($PREC) doit etre un reel non nul et positif...\n\n";
    }
 
    else {
      push(@args, $opt);
    }
  }
 
  #- - - - - - - - - - - - - - - - - - -
  # gestion des arguments obligatoires
  #- - - - - - - - - - - - - - - - - - -
  ($#args >= 3) or die "\nErreur (prog:$NOM_PROG) : arguments manquants...\n\n";
  #argument "fher_1"
  my $fher_1 = shift(@args); (-e $fher_1) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_1 introuvable...\n\n";
  #argument "fdpl_1"
  my $fgmsh_dpl = shift(@args); (-e $fgmsh_dpl) or die "\nErreur (prog:$NOM_PROG) : fichier $fgmsh_dpl introuvable...\n\n";
  #argument "fher_2"
  my $fher_2 = shift(@args); (-e $fher_2) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_2 introuvable...\n\n";
  #argument "racine_fic_calcul"
  my $racine_fcalcul = shift(@args);
 
  return (fher_1 => $fher_1, fgmsh_dpl => $fgmsh_dpl, fher_2 => $fher_2, racine_fcalcul => $racine_fcalcul, PREC => $PREC);
}
 
#########################################################################################################################
#
# ETAPE 1
#
# on lit les maillages. Ce qui nous interesse, ce sont les coordonnees des noeuds.
#   elles seront contenues dans $ref_noeuds_1 et $ref_noeuds_2
#               $ref_noeuds_1 (maillage 1) et $ref_noeuds_2 (maillage 2) pointent vers un tableau de la forme :
#                                     $ref_noeuds_1/2->[i][0]   => coordonnee x du noeud i
#                                     $ref_noeuds_1/2->[i][1]   => coordonnee y du noeud i
#                                     $ref_noeuds_1/2->[i][2]   => coordonnee z du noeud i
#
#   remarques : 1) $nb_noeuds_1/2 => nombre de noeuds dans le maillage 1 ou 2
#               2) $nb_elts_1/2 et $ref_elements_1/2 => inutiles (jamais utilises par la suite)
#
#########################################################################################################################
sub etape1(%) {
  %_ = @_;
  my ($fher_1, $fher_2) = @_{qw(fher_1 fher_2)};
 
  my ($nb_noeuds_1, $ref_noeuds_1,
      $nb_elts_1, $ref_elements_1) = lecture_mail_her($fher_1);
  my ($nb_noeuds_2, $ref_noeuds_2,
      $nb_elts_2, $ref_elements_2) = lecture_mail_her($fher_2);
 
  return (nb_noeuds_1 => $nb_noeuds_1, ref_noeuds_1 => $ref_noeuds_1, nb_elts_1 => $nb_elts_1, ref_elements_1 => $ref_elements_1,
          nb_noeuds_2 => $nb_noeuds_2, ref_noeuds_2 => $ref_noeuds_2, nb_elts_2 => $nb_elts_2, ref_elements_2 => $ref_elements_2);
}
 
#########################################################################################################################
#
# ETAPE 2
#
# on recherche les noeuds communs aux 2 maillages
#   le tableau @tab_corresp_noeud_1_2 contiendra la correspondance entre les 2 maillages sous la forme :
#      $tab_corresp_noeud_1_2[i] = j   => le noeud i du maillage 1 correpsond au noeud j du maillage 2
#
#
# d un point de vue algorithme/strategie, ce n est pas efficace de tester les coordonnes de chaque noeud du maillage 1 et de comparer
#  aux noeuds du maillage 2 (le temps explose quand le nombre de noeuds est grand).
#  donc, on va "pre-macher" le travail :
#   1) pour le maillage 1, on cree des tables de hashage (%TAB_MAIL_1_COORD_X/Y/Z) dont les cles seront les coordonnes X/Y/Z arrondies a la decimale correspondant
#      a la precision $PREC sous la forme :
#        @{$TAB_MAIL_1_COORD_X/Y/Z{valeur coordonne arrondie}} = (liste des noeuds ayant cette coordonnee)
#
#   2) on teste les coordonnees de chaque noeud du maillage 2 et on regarde si une cle de %TAB_MAIL_1_COORD_X/Y/Z pourrait correspondre.
#      si oui, on teste chaque noeud de la liste @{$TAB_MAIL_1_COORD_Z{valeur coordonne}} pour voir si les coordonnees
#      correspondent
#        si oui => on etablit la correspondance $tab_corresp_noeud_1_2[i] = j
#                  et dans la foulee, on en profite pour dresser une liste des noeuds du maillage 2 qui seront a traiter plus tard => @liste_noeuds_2_avec_dpl_imposes (signifiant : "liste des noeuds du maillage 2 qui vont avoir des deplacements imposes")
#
#########################################################################################################################
sub etape2(%) {
  %_ = @_;
  my ($nb_noeuds_1, $ref_noeuds_1, $nb_noeuds_2, $ref_noeuds_2, $PREC) = @_{qw(nb_noeuds_1 ref_noeuds_1 nb_noeuds_2 ref_noeuds_2 PREC)};
 
  my @tab_corresp_noeud_1_2; for(my $i=1; $i<=$nb_noeuds_1; $i++) {$tab_corresp_noeud_1_2[$i] = 0;}
  my @liste_noeuds_2_avec_dpl_imposes;
  my %TAB_MAIL_1_COORD_X;
  my %TAB_MAIL_1_COORD_Y;
  my %TAB_MAIL_1_COORD_Z;
  my $nb_decimales = return_nb_decimales($PREC);#nombre de decimales pour la conversion des coordonnees en string (on utilise $PREC pour fixer le nombre de decimales)
  print "Recherche des noeuds communs...\n";
  #
  # remarque : les operations d arrondi ci-dessous pourrait etre refaites en utilisant le package Math::Round
  #
  for(my $i=1; $i<=$nb_noeuds_1; $i++) {
    $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][0]);
    push(@{$TAB_MAIL_1_COORD_X{$_}}, $i);
    $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][1]);
    push(@{$TAB_MAIL_1_COORD_Y{$_}}, $i);
    $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][2]);
    push(@{$TAB_MAIL_1_COORD_Z{$_}}, $i);
  }
  my $coord_char;
  for(my $i=1; $i<=$nb_noeuds_2; $i++) {
    $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][0]);
    next if(not defined($TAB_MAIL_1_COORD_X{$coord_char}));
    $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][1]);
    next if(not defined($TAB_MAIL_1_COORD_Y{$coord_char}));
    $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][2]);
    next if(not defined($TAB_MAIL_1_COORD_Z{$coord_char}));
    foreach my $noeud_1 (@{$TAB_MAIL_1_COORD_Z{$coord_char}}) {
      next if(abs($ref_noeuds_2->[$i][0] - $ref_noeuds_1->[$noeud_1][0]) > $PREC);
      next if(abs($ref_noeuds_2->[$i][1] - $ref_noeuds_1->[$noeud_1][1]) > $PREC);
      next if(abs($ref_noeuds_2->[$i][2] - $ref_noeuds_1->[$noeud_1][2]) > $PREC);
      $tab_corresp_noeud_1_2[$noeud_1] = $i;
      push(@liste_noeuds_2_avec_dpl_imposes, $i);
      last;
    }
  }
  print "nombre de noeuds communs aux 2 maillages : ", $#liste_noeuds_2_avec_dpl_imposes+1, "\n";
 
  return (liste_noeuds_2_avec_dpl_imposes => \@liste_noeuds_2_avec_dpl_imposes, tab_corresp_noeud_1_2 => \@tab_corresp_noeud_1_2);
}
 
sub read_dpl($%) {
  my ($fgmsh_dpl, %opt) = @_;
 
  my $nb_noeuds = $opt{all};
  my $filter = $opt{filter};
 
  my (@liste_temps, @table_dpl_1, %liste_dpl);
 
  open(FIC, "<$fgmsh_dpl");
  my $no_node = 0;
  while(<FIC>) {last if(/^\s*\$NodeData\s*$/);}
  while(<FIC>) {
    $no_node++;
    <FIC>;<FIC>;
    my $temps = <FIC>;
    ($temps) = $temps =~ /($format_reel)/ or
      $nb_noeuds && die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fgmsh_dpl pour le \$NodeData no $no_node...\n\n";
    if ($nb_noeuds) {
      print "  verification deplacements au temps : $temps\n" if $verbose;
      push(@liste_temps, $temps);
    }
    my $nb_lines = <FIC>; chomp $nb_lines; <FIC> while $nb_lines--;
    while(<FIC>) {
      last if(/^\s*\$NodeData\s*$/);
      chomp;
      (my ($noeud_lu, $UX, $UY, $UZ) = split /\s+/) >= 4 or next;
 
      if ($nb_noeuds) {
        $table_dpl_1[$noeud_lu] = [ $UX, $UY, $UZ ];
      }
      elsif (!@$filter || grep $noeud_lu == $_, @$filter) {
        push @{$liste_dpl{$noeud_lu}}, [ $UX, $UY, $UZ ];
      }
    }
 
    if ($nb_noeuds) {
      #verif de la lecture des deplacements
      foreach my $i (1 .. $nb_noeuds) {
        (defined($table_dpl_1[$i][0]) and defined($table_dpl_1[$i][1]) and defined($table_dpl_1[$i][2]))
          or die "\nErreur (prog:$NOM_PROG) : deplacement non defini au temps $temps pour le noeud $i...\n\n";
      }
    }
  }
  close(FIC);
 
  return $nb_noeuds ? \@liste_temps : \%liste_dpl;
}
 
#########################################################################################################################
#
# ETAPE 3
#
#   verif prealable des deplacements dans le fichier $fgmsh_dpl
#   (on s assure que les deplacements soient valides avant de creer tout un tas de fichiers temporaires qui ne seraient pas effaces a cause d un "die")
#
#  cette etape est un peu longue (c est pas la pire), mais me parait necessaire
#
#########################################################################################################################
sub etape3(%) {
  %_ = @_;
  my ($fgmsh_dpl, $nb_noeuds_1) = @_{qw(fgmsh_dpl nb_noeuds_1)};
 
  print "Verification des deplacements...\n";
 
  return temps => read_dpl($fgmsh_dpl, all => $nb_noeuds_1);
}
 
#########################################################################################################################
#
# ETAPE 4
#
# creation de fichiers temporaires dans lesquels on va stocker les courbes temps-deplacement de chaque noeud de la liste @$liste_noeuds_2_avec_dpl_imposes
#
#  en gros, on cree autant de fichiers que de noeuds communs aux 2 maillages pour X, Y et Z (donc => 3 fois $#$liste_noeuds_2_avec_dpl_imposes+1 fichiers)
#
#  inutile de decrire le contenu de ces fichiers. Juste peut-etre dire qu ils vont principalement contenir une suite de lignes de la forme :
#        Coordonnee dim= 2  valeur_temps   valeur_deplacement
#
#
#
#  remarque : a partir de cette etape, on capture le signal d interruption $SIG{INT} pour effacer les fichiers temporaires
#             avant de quitter
#
#
#
#  c est cette etape qui est tres lente car en plus de la lecture du fichier fdpl_1 (similairement a l ETAPE 3), il y a de 
#    nombreux acces disque pour ecrire les fichiers temporaires (et peut-etre d autres choses qui m echappent ???)
#      c est cette etape qu il faut ameliorer et/ou paralleliser
#
#########################################################################################################################
sub etape4(%) {
  %_ = @_;
  my ($nb_noeuds_1, $fgmsh_dpl, $liste_noeuds_2_avec_dpl_imposes, $array_temps, $tab_corresp_noeud_1_2, $racine_fcalcul) =
    @_{qw(nb_noeuds_1 fgmsh_dpl liste_noeuds_2_avec_dpl_imposes temps tab_corresp_noeud_1_2 racine_fcalcul)};
 
  #liste des noms de fichiers temporaires
  my %liste_fic;
  my @labels_U = qw(UX UY UZ);
 
  print "Initialisation des fichiers temporaires...\n";
  foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
    foreach my $label_U (@labels_U) {
      push @{$liste_fic{$noeud}->{$label_U}}, "  ${label_U}_noeud_$noeud COURBEPOLYLINEAIRE_1_D\n";
      push @{$liste_fic{$noeud}->{$label_U}}, "    Debut_des_coordonnees_des_points\n";
      push @{$liste_fic{$noeud}->{$label_U}}, "      Coordonnee dim= 2 0. 0.\n" if(abs($array_temps->[0]) > 1e-11);
    }
  }
 
  #remplissage des fichiers temporaires
  print "Remplissage des fichiers temporaires...\n";
 
  my $nb_noeuds_traites = 0;
  my $nb_noeuds_a_traiter = @$liste_noeuds_2_avec_dpl_imposes;
 
  #lecture du fichier deplacement fdpl_1 et saisie des deplacements pour le noeud $noeud_1
  my ($liste_dpl) = read_dpl($fgmsh_dpl, filter => [ grep $tab_corresp_noeud_1_2->[$_], 1 .. $nb_noeuds_1 ] ); # read all nodes
 
  #for(my $noeud_1=1; $noeud_1<=$nb_noeuds_1; $noeud_1++) {
  foreach my $noeud_1 (keys %$liste_dpl) {
    my $noeud_2 = $tab_corresp_noeud_1_2->[$noeud_1];
 
    #on ne fait pas de traitement si le noeud $noeud_1 du maillage 1 n a pas de correspondance dans le maillage 2
    #next if(not $noeud_2);
 
    $nb_noeuds_traites++;
    print "  traitement noeud : $nb_noeuds_traites / $nb_noeuds_a_traiter\n";
 
    #ajout a la suite des fichiers temporaires X Y Z correspondant a ce noeud
    for(my $i=0; $i<=$#$array_temps; $i++) {
      my $index_U = 0;
      for my $label_U (@labels_U) {
        push @{$liste_fic{$noeud_2}->{$label_U}}, "      Coordonnee dim= 2 $array_temps->[$i] $liste_dpl->{$noeud_1}->[$i]->[$index_U]\n";
        $index_U++;
      }
    }
    for my $label_U (@labels_U) {
      push @{$liste_fic{$noeud_2}->{$label_U}}, "      Fin_des_coordonnees_des_points\n";
    }
  }
 
  print "\nRappel du nombre de noeuds communs aux 2 maillages : ", $#$liste_noeuds_2_avec_dpl_imposes+1, "\n\n";
 
  #recopie des fichiers temporaires dans un seul fichier de nom $racine_fcalcul.courbes
  #  (on concatene tout simplement les fichiers temporaires au sein d un seul fichier, et on efface les fichiers temporaires)
  print "Recopie des fichiers temporaires au sein d un seul fichier...\n";
  open my $FIC, ">", "$racine_fcalcul.courbes";
  foreach my $noeud (sort { $a <=> $b } keys %liste_fic) {
    foreach my $label_U (@labels_U) {
      print { $FIC } "\n";
      print { $FIC } @{$liste_fic{$noeud}->{$label_U}};
    }
  }
  print " > Le fichier $racine_fcalcul.courbes a ete cree (courbes temps-deplacement par noeud)...\n";
 
  return ();
}
 
#########################################################################################################################
#
# ETAPE 5
#
#  derniers traitements : creation de quelques fichiers supplementaires
#
#  cette etape ne prend pas beaucoup de temps
#
#########################################################################################################################
sub etape5(%) {
  %_ = @_;
  my ($racine_fcalcul, $liste_noeuds_2_avec_dpl_imposes, $array_temps) =
    @_{qw(racine_fcalcul liste_noeuds_2_avec_dpl_imposes temps)};
 
  #creation des listes noeud pour l application des dpl imposes (creation du fichier $racine_fcalcul.lis)
  print "Creation des listes de reference de noeud...\n";
  open(FIC, ">$racine_fcalcul.lis");
  foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
    print FIC "\n";
    print FIC " N_dpl_impose_$noeud $noeud\n";
  }
  close(FIC);
  print " > Le fichier $racine_fcalcul.lis a ete cree (references de noeud pour l application des deplacements)...\n";
 
  #creation du fichier de conditions limites en deplacement impose (creation du fichier $racine_fcalcul.cl)
  print "Creation du fichier de conditions limites...\n";
  open(FIC, ">$racine_fcalcul.cl");
  foreach my $noeud (@$liste_noeuds_2_avec_dpl_imposes) {
    print FIC "\n";
    print FIC " N_dpl_impose_$noeud \'UX= COURBE_CHARGE: UX_noeud_$noeud ECHELLE: 1.\'\n";
    print FIC " N_dpl_impose_$noeud \'UY= COURBE_CHARGE: UY_noeud_$noeud ECHELLE: 1.\'\n";
    print FIC " N_dpl_impose_$noeud \'UZ= COURBE_CHARGE: UZ_noeud_$noeud ECHELLE: 1.\'\n";
  }
  close(FIC);
  print " > Le fichier $racine_fcalcul.cl a ete cree (conditions de deplacements imposes)...\n";
 
  #creation du fichier de typecharge TYPE5 pour imposer les instants de calcul (creation du fichier $racine_fcalcul.TYPE5)
  print "Creation du fichier de typecharge TYPE5...\n";
  open(FIC, ">$racine_fcalcul.TYPE5");
  print FIC "  TYPE5 COURBEPOLYLINEAIRE_1_D\n";
  print FIC " 	Debut_des_coordonnees_des_points\n";
  print FIC " 	  Coordonnee dim= 2 0. 1.\n" if(abs($array_temps->[0]) > 1e-11);
  foreach my $temps (@$array_temps) {print FIC " 	  Coordonnee dim= 2 $temps 1.\n";}
  print FIC "      Fin_des_coordonnees_des_points\n";
  close(FIC);
  print " > Le fichier $racine_fcalcul.TYPE5 a ete cree (typecharge de type TYPE5)...\n\n";
}
 
sub return_nb_decimales {
  my $nombre = shift;
  $nombre = abs($nombre);
  my $nb_decimales = 0;
  while() {
    last if($nombre >= 1);
    $nombre *= 10;
    $nb_decimales++;
  }
  return $nb_decimales;
}
 
 
#----------------
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
#
# exemple d appel :
#  my ($nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her");
#
#  avec - $nb_noeuds        : nombre de noeuds (entier)
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
#       - $nb_elts          : nombre d elements (entier)
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
#                                
sub lecture_mail_her {
  my $fher = shift;
 
  #------------------------
  # lecture du maillage .her
  #------------------------
  #-lecture de noeuds
  my @tab_noeuds; my $nb_noeuds;
  my $no_noeud = 0;
  open(Fher, "<$fher");
  while(<Fher>) {
    next if(not /(\d+)\s+NOEUDS/);
    $nb_noeuds = $1;
    last;
  }
  while(<Fher>) {
    last if($no_noeud == $nb_noeuds);
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);
    $no_noeud = $1;
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
  }
 
  #-lecture des elements
  my %tab_elements; my $nb_elts;
  my $no_elt = 0;
  while(<Fher>) {
    next if(not /(\d+)\s+ELEMENTS/);
    $nb_elts = $1;
    last;
  }
  while(<Fher>) {
    last if($no_elt == $nb_elts);
    next if(not /^\s*\d+\s+\w+\s+\w+/);
    s/^\s+//;s/\s+$//;
    $_ =~ /^(\d+)\s+/;
    $no_elt = $1; s/^(\d+)\s+//;
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
  }
  close(Fher);
 
 
  #------------------------
  # lecture des references (dans le .her et dans un eventuel .lis)
  #------------------------
  my $flis = $fher; $flis =~ s/.her$/.lis/;
  my $nom_liste;
  my $is_liste_en_cours;
  my %listes_NOEUDS;
  my %listes_ARETES;
  my %listes_FACES;
  my %listes_ELEMENTS;
 
  #-dans le .her
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
 
  #dans le .lis (si il existe)
  if(-e $flis) {
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  }#if(-e $flis)
 
  #AFFICHAGE DES LISTES DE NOEUDS
  #foreach my $nom (keys(%listes_NOEUDS)) {
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES D ARETES
  #foreach my $nom (keys(%listes_ARETES)) {
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES DE FACES
  #foreach my $nom (keys(%listes_FACES)) {
  #  print "$nom : @{$listes_FACES{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES D ELEMENTS
  #foreach my $nom (keys(%listes_ELEMENTS)) {
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
  #}
 
  return($nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
         \%listes_NOEUDS, \%listes_ARETES,
         \%listes_FACES, \%listes_ELEMENTS);
}#sub lecture_mail_her

**seagull** · 02/10/2015, 11h10

Philou67430 :
Je suis étonné par la manière dont tu passes les arguments successivement aux subroutines d'étape par accumulation dans un hash. C'est joli. C’est une manière de faire classique ?
J’ai du mal à piger comment les sub peuvent récupérer un hash alors qu’elle reçoivent la liste @_!!!
la forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

%_ = @_;

était pour moi impensable. J’ai testé pour comprendre : la liste @_ contient une suite : clé, valeur, clé, valeur, etc… et quand on affecte @_ à un hash (%_), ça construit le hash!!!! Il faut l’avoir vu une fois pour y penser.
et ensuite la tournure @_{qw(…)}, pareil, il faut l’avoir vu une fois.

petite question : une fois une subroutine d’étape terminée, toutes ses variables sont détruites (libérant ainsi de la mémoire pour les étapes suivantes) ?

Bref. Merci pour ton code.

de mon côté, j’ai testé vite fait avec base de données SQLite. Je suis pour l’instant déçu car :
1. ça prend un temps considérable pour créer la base de données (il m’a fallu 10 minutes rien que pour créer les 80 premiers NodeData sur les 1644!!!! j’ai donc arrêté l’exécution)
2. ma mémoire est saturée pendant la création de cette base (et l’activité processeur de mon script descend à 25%, d’où sans doute le temps d’exécution minable)

voici mon code sur le principe du tuto de djibril http://djibril.developpez.com/tutoriels/perl/perl-dbi/. Son but est uniquement de créer la base de données deplace.db en reprenant le bloc de lecture du fichier fdpl_1.pos :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
#!/usr/bin/env perl
#!/usr/local/bin/perl
use strict;
use warnings;
use English;
use File::Basename;
 
#use DBD::SQLite; #apparemment use DBI suffit
use DBI;
 
my $NOM_PROG = basename $PROGRAM_NAME;
#pattern d un reel pour les regex (pourrait etre remplacee par $RE{num}{real} du package Regexp::Common)
my $format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';
 
($#ARGV == 0) or die "Erreur : 1 arg requis...\n\n";
my $fdeplace = shift(@ARGV); (-e $fdeplace) or die "Erreur : fichier $fdeplace introuvable...\n\n";
 
system("rm -f deplace.db");
my $BDD = DBI->connect("dbi:SQLite:dbname=deplace.db", "", "");
 
$BDD->do('CREATE TABLE deplace (id INTEGER AUTO_INCREMENT PRIMARY KEY, increment INTEGER, noeud INTEGER, ux REAL, uy REAL, uz REAL);') or die "pb creation table : ", $BDD->errstr, "\n";
 
my $insertion_donnee = $BDD->prepare('INSERT INTO deplace (id, increment, noeud, ux, uy, uz) VALUES(?, ?, ?, ?, ?, ?);') or die "pb preparation insertion donnee : ", $BDD->errstr, "\n";
 
my $REGEX_QR_NodeData = qr/\$NodeData/;
my $nb_incr = 0;
my $nb_noeuds = 0;
open(FIC, "<$fdeplace");
while(<FIC>) {
  next if(not /$REGEX_QR_NodeData/o);
  $nb_incr++;
  $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>;
  /($format_reel)/ or die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fdeplace pour le \$NodeData no $nb_incr...\n\n";
  my $temps = $1;
  print "  enregistrement au temps : $temps\n";
  $_[0] = <FIC>; chomp; $_[1] = <FIC> for(1 .. $_[0]);
  (not $nb_noeuds) and do {
                           $_[1] =~ /(\d+)/o or die "\nErreur (prog:$NOM_PROG) : impossible de lire le nombre de noeuds dans le fichier $fdeplace pour le \$NodeData no $nb_incr...\n\n";;
                           $nb_noeuds = $1;
                          };
  #on suppose que le fichier ne contient pas de surprise : donc lecture directe de $nb_noeuds lignes avec un for()
  for(my $i=1; $i<=$nb_noeuds; $i++) {
    $_ = <FIC>;
    @_ = split;
    $insertion_donnee->execute(undef, $nb_incr, @_) or die "pb insertion donnee : ", $BDD->errstr, "\n";
  }
}
close(FIC);
 
$BDD->disconnect();

**Philou67430** · 02/10/2015, 11h59

Envoyé par seagull

Philou67430 :
Je suis étonné par la manière dont tu passes les arguments successivement aux subroutines d'étape par accumulation dans un hash. C'est joli. C’est une manière de faire classique ?

Non, ce n'est pas classique. Mais je voulais changer le moins possible tes noms de variables. Comme chaque étape était isolée, les variables qui étaient globales sont devenues locales. J'ai donc utilisé un hash global pour les récupérer lors de l'appel des étapes, ainsi que pour les transmettre lors de l'appel (à la manière de paramètres nommés).
Ainsi, j'avais moins de risque de m'emmêler les pinceaux.

J’ai du mal à piger comment les sub peuvent récupérer un hash alors qu’elle reçoivent la liste @_!!!
la forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

%_ = @_;

était pour moi impensable. J’ai testé pour comprendre : la liste @_ contient une suite : clé, valeur, clé, valeur, etc… et quand on affecte @_ à un hash (%_), ça construit le hash!!!! Il faut l’avoir vu une fois pour y penser.

Il n'y a en fait rien de compliqué à comprendre %_ = @_ : c'est comme initialiser un hash avec une liste.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my %hash = (toto => 1, titi => 2);

est exactement identique à :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
my @array = (toto, 1, titi, 2);
my %hash = @array;

En revanche, on peut se poser la question du résultat de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

@_ = %_;

Pourtant, c'est aussi assez simple à comprendre, ça revient exactement à la magie des passages de paramètres "nommés" :
a(toto => 1, titi => 2);
devient dans la fonction a :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
sub a {
  my %param = @_;
  print "toto = $param{toto}\n";
}

et ensuite la tournure @_{qw(…)}, pareil, il faut l’avoir vu une fois.

OK, je suis d'accord que la syntaxe d'un slice d'éléments d'un hash n'est pas simple ... ça devrait s'améliorer avec perl6.

petite question : une fois une subroutine d’étape terminée, toutes ses variables sont détruites (libérant ainsi de la mémoire pour les étapes suivantes) ?

Toutes les variables "my" dont la référence n'est pas retournée par la fonction étape sont détruites. Les autres, sont conservées tant que %opt est défini (c'est à dire jusqu'à la fin du programme).

**Philou67430** · 02/10/2015, 12h18

Je reprendrais la suite des évolutions lundi. En attendant, je t'invite à essayer ma version 8 (la dernière) avec des fichiers de données plus gros, histoire de voir si ça passe toujours chez toi. Dans la prochaine étape, j'ai prévu des surveiller la conso mémoire du programme.

Bon week-end à tous.

**Lolo78** · 03/10/2015, 13h11

Envoyé par seagull

de mon côté, j’ai testé vite fait avec base de données SQLite. Je suis pour l’instant déçu car :
1. ça prend un temps considérable pour créer la base de données (il m’a fallu 10 minutes rien que pour créer les 80 premiers NodeData sur les 1644!!!! j’ai donc arrêté l’exécution)
2. ma mémoire est saturée pendant la création de cette base (et l’activité processeur de mon script descend à 25%, d’où sans doute le temps d’exécution minable)

Il y a quelque chose qui ne va pas, car SQLite est réputé très rapide. Il faut sans doute explorer les options (autocommit, etc.) pour comprendre. Par ailleurs, pour tirer parti de SQLite, il faudra que tu ajoutes un index sur l'ID, pour permettre une recherche rapide sur ce champ.

**seagull** · 05/10/2015, 16h21

bon. j’ai bien fait mumuse ce week-end.

1) j’ai testé la version de philou67430
sur ma machine, pour 86 noeuds, j’ai cet ordre de grandeur : environ 55s.

Pour aller plus loin, j’ai testé avec tous les noeuds (i.e fher1.her en 3eme argument i.e 3362 noeuds). ça passe mais c’est costaud. L’ordre de grandeur du temps d’exécution est 14min 30s. Il passe un temps fou à charger en mémoire (mais une fois fait, le traitement est très rapide). Pendant la phase de mise en mémoire, la mémoire grimpe progressivement pour atteindre environ 2500M, puis au moment où les traitements s’enclenchent, elle grimpe rapidement, pour atteindre environ 3500M (ce qui m’étonne vu que normalement il a déjà tout en mémoire). c’est bien gourmand.
A noter quand même qu’avec ma version initiale, c’est un traitement qui dure environ 2h (de mémoire, c’est peut-être plus).

2) j’ai laissé de côté les BDD pour l’instant (j’ai tenté de trouver une option pour désactiver l’autocommit qui couterait du temps sans trop savoir exactement ce que ça veut dire. bref…)

3) j’ai testé une solution combinant seek-tell avec la méthode du split de fichier… et là, j’ai envie de dire bingo!
dans les grandes lignes, voici les nouveautés :
a- je profite de l’ETAPE 3 pour construire une table de tell me permettant de me positionner rapidement dans le fichier d’entrée. Le split est géré à ce niveau, c’est-à-dire que je ne recopie pas le fichier en plusieurs mais le split est "simulé" en enregistrant plus de tell selon l’option -split que j’ai rajoutée (i.e un split par NodeData + 1 split tous les N noeuds au sein d’un NodeData).

b- dans l’ETAPE 4, le fichier d’entrée n’est ouvert qu’une seule fois et on se positionne dedans grâce à seek en fonction du NodeData et du numéro de noeud. J’ai constaté qu’un split tous les 20 noeuds était satisfaisant (pas ou peu de gain en dessous de cette valeur).
Il n’y a plus d’écriture des milliers de fichiers temporaires (seulement 3 fichiers temporaires + recopie directe dans le fichier final avant de passer à un nouveau noeud)

c- à signaler que dans l’ETAPE 3 de vérification, j’ai allégé la vérif en ne vérifiant la présence des données que pour le noeud 1 et le dernier noeud (si c'est ok pour le premier et le dernier, il y a quand même de fortes chances que ce soit ok pour les autres).

d- j’ai utilisé //o dans les regex partout où c’était possible et privilégié split

voici les ordres de grandeur de temps d’exécution :
pour 86 noeuds :
- sans split => 23s
- avec -split 500 => 17s
- avec -split 200 => 8-9s
- avec -split 20 => 4-5s
***** edit : j'ai oublié de préciser que la modif de l'ETAPE 3 de vérif fait tomber le temps de la seule ETAPE 3 de 45s à 2s, ce qui fait qu'à mon avis la version de philou67430 devrait avoir un temps de l'ordre de grandeur de ma version -split 200 voire moins si elle incorporait cette modif. *****

pour 3362 noeuds :
- avec -split 20 => 1min 37s (mémoire : 32M)
- avec -split 10 => 1min 30s (mémoire : 42M)

Efficace et vraiment peu gourmand en mémoire. On peut faire tourner autre chose en même temps sans problème. Si la version initiale demandait 2h, on est sur un facteur 60 en gain. Que ce soit en chargeant en mémoire ou créant une base de données, la phase de préparation risque d’être longue. Avec la méthode tell-seek, le programme commence presque immédiatement à écrire le fichier final et ça s’avère payant.

j’ai également testé avec multi-threading mais le gain de temps n’est pas significatif étant donné que le traitement d’un noeud à l’ETAPE 4 ne prend plus énormément de temps. Du coup, 1) ma tambouille de thread est trop lourde pour être réellement bénéfique, 2) le multi-threading oblige à écrire plein de fichiers temporaires + concaténation comme dans la version initiale. J’ai réussi à descendre à 1min 20s avec 2 threads et 1min 18s avec 3 threads, ce qui montre bien que le gain est négligeable et ne vaut pas le coup d’occuper du processeur.

Voici le code de la version sans multi-threading (suivi d’un code qui permet de remettre dans l’ordre le fichier .courbes pour pouvoir comparer avec les anciennes versions) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
#!/usr/bin/env perl
#!/usr/local/bin/perl
use strict;
use warnings;
use English;
use File::Basename;
use File::Temp qw/tempfile/;
use Text::Wrap;
$Text::Wrap::columns = 81;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1)
my $NOM_PROG = basename $PROGRAM_NAME;
#pattern d un reel pour les regex (pourrait etre remplacee par $RE{num}{real} du package Regexp::Common)
my $format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';
 
 
#########################################################################################################################
#
# resume des etapes :
#   ETAPE 0 => recuperation des arguments, affichage eventuel de l aide, etc... (rien a signaler => etape rapide)
#   ETAPE 1 => lecture des 2 maillages (rien a signaler => etape rapide)
#   ETAPE 2 => determination des noeuds communs aux 2 maillages (rien a signaler => etape rapide)
#   ETAPE 3 => verification du fichier fdpl_1 contenant les deplacements (etape un peu longue mais sans plus)
#   ETAPE 4 => ecriture de plein fichiers temporaires que l on concatene ensuite un seul fichier (ETAPE TRES LONGUE!!!!!!!!!)
#   ETAPE 5 => ecriture de quelques fichiers supplementaires (rien a signaler => etape rapide)
#
#########################################################################################################################
 
 
 
 
 
#########################################################################################################################
#
# ETAPE 0
#
#   recuperation des arguments, affichage eventuel de l aide, etc...
#
#   rien a dire sauf qu un jour, il faudra vraiment que je regarde le package getopt
#   bref...
#
#########################################################################################################################
 
#premier balyage des arguments pour reperer une demande d affichage de l aide
# => si option du style -h ou -help => affichage aide
my $isOpt_help = 0;
foreach my $arg (@ARGV) {
  if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
    $isOpt_help = 1;
  }
}
 
#si option -h|-help ou pas d arguments => affichage aide
if($isOpt_help or ($#ARGV < 3)) {
  my $indent = "    "; $indent .= " " for(1 .. length($NOM_PROG));
  print "\n";
  print "--------------------------------------------------------------------------------\n";
  print wrap("",$indent,
  " $NOM_PROG - saisir les deplacements Gmsh issus d un calcul sur un maillage 1 et appliquer ces deplacements sur un maillage 2 aux noeuds communs entre les 2 maillages\n");
  print "--------------------------------------------------------------------------------\n";
  print "\n";
  print "  USAGE :\n";
  print "    $NOM_PROG [-h|help] [-prec PREC] fher_1 fdpl_1 fher_2 racine_fic_calcul\n";
  print "\n";
  print "  ARGUMENTS :\n";
  print "    fher_1 : fichier maillage 1 (.her)\n";
  print "    fdpl_1 : fichier resultat Gmsh contenant la grandeur \"deplace\"\n";
  print "    fher_2 : fichier maillage 2 (.her)\n";
  print "    racine_fic_calcul : chaine de caracteres utilisee pour nommer les\n";
  print "                        fichiers suivants qui vont etre crees :\n";
  print "                          - racine_fic_calcul.courbes => courbe temps-deplacement par noeud\n";
  print "                          - racine_fic_calcul.lis     => listes de references par noeud\n";
  print "                          - racine_fic_calcul.cl      => conditions de blocage\n";
  print "                          - racine_fic_calcul.TYPE5   => chargement global de TYPE5\n";
  print "                                                         (voir doc herezh : typecharge)\n";
  print "\n";
  print "  OPTIONS :\n";
  print "    -prec PREC : changer la precision sur les coordonnes des noeuds pour rechercher\n";
  print "                 les noeuds communs entre maillage fher_1 et fher_2 (par defaut : 1e-6)\n";
  print "\n";
  print "    -split nb_noeuds_split : nombre de noeuds pour spliter les donnees pour faciliter la\n";
  print "                             lecture du fichier fdpl_1\n";
  print "                             (par defaut : 20)\n";
  print "                             cette option modifie la rapidite d execution. Plus nb_noeuds\n";
  print "                             est petit, plus le traitement sera rapide avec neanmoins un\n";
  print "                             surcout de stockage (besoin en memoire vive)\n";
  print "\n";
  print "\n";
  print "  REMARQUE :\n";
  print "    Seuls les noeuds du maillage fher_2 qui sont communs avec ceux du maillage fher_1\n";
  print "    auront des conditions de deplacements imposes. Les autres noeuds seront libres.\n";
  print "\n";
  print "  CONSEILS D UTILISATION DES FICHIERS racine_fic_calcul.* :\n";
  print "    Les fichiers crees peuvent etre inseres tels quel dans un .info via des includes \'<\'.\n";
  print "    1) Dans la partie maillage, le fichier racine_fic_calcul.lis peut etre mis a\n";
  print "    la suite de la declaration du maillage :\n";
  print "      < fher_2(.her)\n";
  print "      < fher_2(.lis)\n";
  print "      < racine_fic_calcul.lis\n";
  print "\n";
  print "    2) le fichier racine_fic_calcul.courbes est a inserer au niveau \'les_courbes_1D\'\n";
  print "    3) le fichier racine_fic_calcul.cl est a inserer au niveau \'blocages\'\n";
  print "    4) le fichier racine_fic_calcul.TYPE5 est a inserer au niveau \'typecharge\' si\n";
  print "       on souhaite obtenir un calcul exactement aux memes instants que le calcul de\n";
  print "       reference. Dans ce cas, verifier que les parametres de \'controle\' DELTAtMINI\n";
  print "       et DELTAtMAXI permettent de respecter ces temps (on peut mettre\n";
  print "       DELTAtMINI=1.e-90 et DELTAtMAXI = 1.e+90 et laisser herezh gerer)\n";
  print "\n";
  print "--------------------------------------------------------------------------------\n";
  print "\n";
  exit;
}
 
#- - - - - - - - - - - - - - - - - - -
# gestion des options
#- - - - - - - - - - - - - - - - - - -
#precision pour la recherche des noeuds confondus (1.e-6 par defaut, modifiable avec option -prec)
my $PREC = 1e-6;
#nombre de noeuds pour split les donnees (20 par defaut)
my $nb_noeuds_split = 20;
 
my $opt;
my @args;
while($#ARGV > -1) {
  $opt = shift(@ARGV);
 
  if($opt eq '-prec') {
    $PREC = shift(@ARGV); ($PREC =~ /^$format_reel$/ and $PREC > 0) or die "\nErreur (prog:$NOM_PROG, option: -prec) : la precision ($PREC) doit etre un reel non nul et positif...\n\n";
  }
  elsif($opt eq '-split') {
    $nb_noeuds_split = shift(@ARGV);
    ($nb_noeuds_split =~ /^\d+$/ and $nb_noeuds_split >= 1) or die "\nErreur (prog:$NOM_PROG, option: -split) : le nombre de noeuds par split ($nb_noeuds_split) doit etre un entier non nul et positif...\n\n";
  }
 
  else {
    push(@args, $opt);
  }
}
 
#- - - - - - - - - - - - - - - - - - -
# gestion des arguments obligatoires
#- - - - - - - - - - - - - - - - - - -
($#args >= 3) or die "\nErreur (prog:$NOM_PROG) : arguments manquants...\n\n";
#argument "fher_1"
my $fher_1 = shift(@args); (-e $fher_1) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_1 introuvable...\n\n";
#argument "fdpl_1"
my $fgmsh_dpl = shift(@args); (-e $fgmsh_dpl) or die "\nErreur (prog:$NOM_PROG) : fichier $fgmsh_dpl introuvable...\n\n";
#argument "fher_2"
my $fher_2 = shift(@args); (-e $fher_2) or die "\nErreur (prog:$NOM_PROG) : fichier $fher_2 introuvable...\n\n";
#argument "racine_fic_calcul"
my $racine_fcalcul = shift(@args);
 
 
 
 
 
 
#########################################################################################################################
#
# ETAPE 1
#
# on lit les maillages. Ce qui nous interesse, ce sont les coordonnees des noeuds.
#   elles seront contenues dans $ref_noeuds_1 et $ref_noeuds_2
#               $ref_noeuds_1 (maillage 1) et $ref_noeuds_2 (maillage 2) pointent vers un tableau de la forme :
#                                     $ref_noeuds_1/2->[i][0]   => coordonnee x du noeud i
#                                     $ref_noeuds_1/2->[i][1]   => coordonnee y du noeud i
#                                     $ref_noeuds_1/2->[i][2]   => coordonnee z du noeud i
#
#   remarques : 1) $nb_noeuds_1/2 => nombre de noeuds dans le maillage 1 ou 2
#               2) $nb_elts_1/2 et $ref_elements_1/2 => inutiles (jamais utilises par la suite)
#
#########################################################################################################################
my ($nb_noeuds_1, $ref_noeuds_1,
    $nb_elts_1, $ref_elements_1) = lecture_mail_her($fher_1);
my ($nb_noeuds_2, $ref_noeuds_2,
    $nb_elts_2, $ref_elements_2) = lecture_mail_her($fher_2);
 
 
 
 
 
 
 
#########################################################################################################################
#
# ETAPE 2
#
# on recherche les noeuds communs aux 2 maillages
#   le tableau @tab_corresp_noeud_1_2 contiendra la correspondance entre les 2 maillages sous la forme :
#      $tab_corresp_noeud_1_2[i] = j   => le noeud i du maillage 1 correpsond au noeud j du maillage 2
#
#
# d un point de vue algorithme/strategie, ce n est pas efficace de tester les coordonnes de chaque noeud du maillage 1 et de comparer
#  aux noeuds du maillage 2 (le temps explose quand le nombre de noeuds est grand).
#  donc, on va "pre-macher" le travail :
#   1) pour le maillage 1, on cree des tables de hashage (%TAB_MAIL_1_COORD_X/Y/Z) dont les cles seront les coordonnes X/Y/Z arrondies a la decimale correspondant
#      a la precision $PREC sous la forme :
#        @{$TAB_MAIL_1_COORD_X/Y/Z{valeur coordonne arrondie}} = (liste des noeuds ayant cette coordonnee)
#        
#   2) on teste les coordonnees de chaque noeud du maillage 2 et on regarde si une cle de %TAB_MAIL_1_COORD_X/Y/Z pourrait correspondre.
#      si oui, on teste chaque noeud de la liste @{$TAB_MAIL_1_COORD_Z{valeur coordonne}} pour voir si les coordonnees
#      correspondent
#        si oui => on etablit la correspondance $tab_corresp_noeud_1_2[i] = j
#                  et dans la foulee, on en profite pour dresser une liste des noeuds du maillage 2 qui seront a traiter plus tard => @liste_noeuds_2_avec_dpl_imposes (signifiant : "liste des noeuds du maillage 2 qui vont avoir des deplacements imposes")
#
#########################################################################################################################
my @tab_corresp_noeud_1_2; for(my $i=1; $i<=$nb_noeuds_1; $i++) {$tab_corresp_noeud_1_2[$i] = 0;}
my @liste_noeuds_2_avec_dpl_imposes;
my %TAB_MAIL_1_COORD_X;
my %TAB_MAIL_1_COORD_Y;
my %TAB_MAIL_1_COORD_Z;
my $nb_decimales = return_nb_decimales($PREC);#nombre de decimales pour la conversion des coordonnees en string (on utilise $PREC pour fixer le nombre de decimales)
print "Recherche des noeuds communs...\n";
#
# remarque : les operations d arrondi ci-dessous pourrait etre refaites en utilisant le package Math::Round
#
for(my $i=1; $i<=$nb_noeuds_1; $i++) {
  $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][0]);
  push(@{$TAB_MAIL_1_COORD_X{$_}}, $i);
  $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][1]);
  push(@{$TAB_MAIL_1_COORD_Y{$_}}, $i);
  $_ = sprintf("%.${nb_decimales}f", $ref_noeuds_1->[$i][2]);
  push(@{$TAB_MAIL_1_COORD_Z{$_}}, $i);
}
my $coord_char;
for(my $i=1; $i<=$nb_noeuds_2; $i++) {
  $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][0]);
  next if(not defined($TAB_MAIL_1_COORD_X{$coord_char}));
  $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][1]);
  next if(not defined($TAB_MAIL_1_COORD_Y{$coord_char}));
  $coord_char = sprintf("%.${nb_decimales}f", $ref_noeuds_2->[$i][2]);
  next if(not defined($TAB_MAIL_1_COORD_Z{$coord_char}));
  foreach my $noeud_1 (@{$TAB_MAIL_1_COORD_Z{$coord_char}}) {
	 next if(abs($ref_noeuds_2->[$i][0] - $ref_noeuds_1->[$noeud_1][0]) > $PREC);
	 next if(abs($ref_noeuds_2->[$i][1] - $ref_noeuds_1->[$noeud_1][1]) > $PREC);
	 next if(abs($ref_noeuds_2->[$i][2] - $ref_noeuds_1->[$noeud_1][2]) > $PREC);
	 $tab_corresp_noeud_1_2[$noeud_1] = $i;
	 push(@liste_noeuds_2_avec_dpl_imposes, $i);
	 last;
  }
}
%TAB_MAIL_1_COORD_X = ();
%TAB_MAIL_1_COORD_Y = ();
%TAB_MAIL_1_COORD_Z = ();
print "nombre de noeuds communs aux 2 maillages : ", $#liste_noeuds_2_avec_dpl_imposes+1, "\n";
 
 
#########################################################################################################################
#
# ETAPE 3
#
# 
#   verif prealable des deplacements dans le fichier $fgmsh_dpl
#   (on s assure que les deplacements soient valides avant de creer tout un tas de fichiers temporaires qui ne seraient pas effaces a cause d un "die")
#
#  cette etape est un peu longue (c est pas la pire), mais me parait necessaire
#
#
#
#
#########################################################################################################################
my (@TEMPS, $temps);
my @TAB_TELL_NODEDATA;
my $nb_tell_par_nodedata = int($nb_noeuds_1/$nb_noeuds_split) + 1;
my $nb_incr = 0;
print "Verification des deplacements...\n";
open(FIC, "<$fgmsh_dpl");
while(<FIC>) {
  next if(not /^\s*\$NodeData/o);
  $nb_incr++;
  $_ = <FIC>; $_ = <FIC>; $_ = <FIC>; $_ = <FIC>;
  /($format_reel)/o or die "\nErreur (prog:$NOM_PROG) : impossible de lire le temps dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n";
  $temps = $1;
  print "  verification deplacements au temps : $temps\n";
  push(@TEMPS, $temps);
  $_[0] = <FIC>; chomp; $_[1] = <FIC> for(1 .. $_[0]);
  push(@{$TAB_TELL_NODEDATA[$#TEMPS]}, tell(FIC));
  my $ligne = <FIC>;
  $ligne =~ (/^\s*1\s+$format_reel\s+$format_reel\s+$format_reel/o) or die "\nErreur (prog:$NOM_PROG) : impossible de lire le deplacement du noeud 1 dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n";
  my $borne_fin = ($nb_noeuds_1 < $nb_noeuds_split) ? $nb_noeuds_1 : $nb_noeuds_split;
  for(my $i=2; $i<=$borne_fin; $i++) {$ligne = <FIC>;}
  for(my $nb_tell=2; $nb_tell<=$nb_tell_par_nodedata; $nb_tell++) {
    push(@{$TAB_TELL_NODEDATA[$#TEMPS]}, tell(FIC));
    $borne_fin = ($nb_noeuds_1 < $nb_tell*$nb_noeuds_split) ? $nb_noeuds_1-($nb_tell-1)*$nb_noeuds_split : $nb_noeuds_split;
    for(my $i=1; $i<=$borne_fin; $i++) {$ligne = <FIC>;}
  }
  $ligne =~ (/^\s*$nb_noeuds_1\s+$format_reel\s+$format_reel\s+$format_reel/o) or die "\nErreur (prog:$NOM_PROG) : impossible de lire le deplacement du noeud $nb_noeuds_1 dans le fichier $fgmsh_dpl pour le \$nodedata no $nb_incr...\n\n";
}
close(FIC);
 
 
 
#########################################################################################################################
#
# ETAPE 4
#
#
#
# creation de fichiers temporaires dans lesquels on va stocker les courbes temps-deplacement de chaque noeud de la liste @liste_noeuds_2_avec_dpl_imposes
#
#  en gros, on cree autant de fichiers que de noeuds communs aux 2 maillages pour X, Y et Z (donc => 3 fois $#liste_noeuds_2_avec_dpl_imposes+1 fichiers)
#
#  inutile de decrire le contenu de ces fichiers. Juste peut-etre dire qu ils vont principalement contenir une suite de lignes de la forme :
#        Coordonnee dim= 2  valeur_temps   valeur_deplacement
#
#
#
#  remarque : a partir de cette etape, on capture le signal d interruption $SIG{INT} pour effacer les fichiers temporaires
#             avant de quitter
#
#
#
#  c est cette etape qui est tres lente car en plus de la lecture du fichier fdpl_1 (similairement a l ETAPE 3), il y a de 
#    nombreux acces disque pour ecrire les fichiers temporaires (et peut-etre d autres choses qui m echappent ???)
#      c est cette etape qu il faut ameliorer et/ou paralleliser
#
#
#########################################################################################################################
#fichiers temporaires UX UY UZ
my $ftmp_UX; ($_, $ftmp_UX) = tempfile("tmp_dpl_UX_XXXXXX");
my $ftmp_UY; ($_, $ftmp_UY) = tempfile("tmp_dpl_UY_XXXXXX");
my $ftmp_UZ; ($_, $ftmp_UZ) = tempfile("tmp_dpl_UZ_XXXXXX");
 
 
$SIG{INT} = sub {#maintenant ctrl-c effacera les fichiers temporaires avant exit
  system("rm -f $ftmp_UX $ftmp_UY $ftmp_UZ");
  exit;
};
 
 
#remplissage du fichier .courbes
print "Remplissage du fichier $racine_fcalcul.courbes ...\n";
my ($noeud_1, $noeud_2, $noeud_lu, $UX, $UY, $UZ);
my $nb_noeuds_traites = 0;
my $nb_noeuds_a_traiter = $#liste_noeuds_2_avec_dpl_imposes + 1;
 
open(FCOURBE, ">$racine_fcalcul.courbes");
 
open(FIC, "<$fgmsh_dpl");
for(my $noeud_1=1; $noeud_1<=$nb_noeuds_1; $noeud_1++) {
  $noeud_2 = $tab_corresp_noeud_1_2[$noeud_1];
 
  #on ne fait pas de traitement si le noeud $noeud_1 du maillage 1 n a pas de correspondance dans le maillage 2
  next if(not $noeud_2);
 
 
  $nb_noeuds_traites++;
  print "  traitement noeud : $nb_noeuds_traites / $nb_noeuds_a_traiter (noeud_1 = $noeud_1)\n";
 
 
  #ecriture dans des fichiers temporaires avant recopie dans fichier final
  open(F_UX, ">$ftmp_UX");
  open(F_UY, ">$ftmp_UY");
  open(F_UZ, ">$ftmp_UZ");
  for(my $i=0; $i<=$#TEMPS; $i++) {
    my $no_tell = int(($noeud_1-1)/$nb_noeuds_split);
    seek(FIC, $TAB_TELL_NODEDATA[$i][$no_tell], 0);
    for(my $j=$no_tell*$nb_noeuds_split+1; $j<=$noeud_1-1; $j++) {<FIC>;}
    $_ = <FIC>;
    ($_, $UX, $UY, $UZ) = split;
    print F_UX "$TEMPS[$i] $UX\n";
    print F_UY "$TEMPS[$i] $UY\n";
    print F_UZ "$TEMPS[$i] $UZ\n";
  }
  close(F_UX);
  close(F_UY);
  close(F_UZ);
 
  #ecriture dans le fichier final
  open(F_U, "<$ftmp_UX");
  print FCOURBE "\n";
  print FCOURBE "  UX_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n";
  print FCOURBE "    Debut_des_coordonnees_des_points\n";
  print FCOURBE "      Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11);
  while(<F_U>) {print FCOURBE "      Coordonnee dim= 2 $_";}
  close(F_U);
  print FCOURBE "      Fin_des_coordonnees_des_points\n\n";
 
  open(F_U, "<$ftmp_UY");
  print FCOURBE "  UY_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n";
  print FCOURBE "    Debut_des_coordonnees_des_points\n";
  print FCOURBE "      Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11);
  while(<F_U>) {print FCOURBE "      Coordonnee dim= 2 $_";}
  close(F_U);
  print FCOURBE "      Fin_des_coordonnees_des_points\n\n";
 
  open(F_U, "<$ftmp_UZ");
  print FCOURBE "  UZ_noeud_$noeud_2 COURBEPOLYLINEAIRE_1_D\n";
  print FCOURBE "    Debut_des_coordonnees_des_points\n";
  print FCOURBE "      Coordonnee dim= 2 0. 0.\n" if(abs($TEMPS[0]) > 1e-11);
  while(<F_U>) {print FCOURBE "      Coordonnee dim= 2 $_";}
  close(F_U);
  print FCOURBE "      Fin_des_coordonnees_des_points\n";
}
close(FIC);
close(FCOURBE);
system("rm -f $ftmp_UX $ftmp_UY $ftmp_UZ");
 
print "\nRappel du nombre de noeuds communs aux 2 maillages : ", $#liste_noeuds_2_avec_dpl_imposes+1, "\n\n";
 
print " > Le fichier $racine_fcalcul.courbes a ete cree (courbes temps-deplacement par noeud)...\n";
 
 
 
#########################################################################################################################
#
# ETAPE 5
#
#
#
#  derniers traitements : creation de quelques fichiers supplementaires
#
#  cette etape ne prend pas beaucoup de temps
#
#
#
#########################################################################################################################
 
#creation des listes noeud pour l application des dpl imposes (creation du fichier $racine_fcalcul.lis)
print "Creation des listes de reference de noeud...\n";
open(FIC, ">$racine_fcalcul.lis");
foreach my $noeud (@liste_noeuds_2_avec_dpl_imposes) {
  print FIC "\n";
  print FIC " N_dpl_impose_$noeud $noeud\n";
}
close(FIC);
print " > Le fichier $racine_fcalcul.lis a ete cree (references de noeud pour l application des deplacements)...\n";
 
#creation du fichier de conditions limites en deplacement impose (creation du fichier $racine_fcalcul.cl)
print "Creation du fichier de conditions limites...\n";
open(FIC, ">$racine_fcalcul.cl");
foreach my $noeud (@liste_noeuds_2_avec_dpl_imposes) {
  print FIC "\n";
  print FIC " N_dpl_impose_$noeud \'UX= COURBE_CHARGE: UX_noeud_$noeud ECHELLE: 1.\'\n";
  print FIC " N_dpl_impose_$noeud \'UY= COURBE_CHARGE: UY_noeud_$noeud ECHELLE: 1.\'\n";
  print FIC " N_dpl_impose_$noeud \'UZ= COURBE_CHARGE: UZ_noeud_$noeud ECHELLE: 1.\'\n";
}
close(FIC);
print " > Le fichier $racine_fcalcul.cl a ete cree (conditions de deplacements imposes)...\n";
 
#creation du fichier de typecharge TYPE5 pour imposer les instants de calcul (creation du fichier $racine_fcalcul.TYPE5)
print "Creation du fichier de typecharge TYPE5...\n";
open(FIC, ">$racine_fcalcul.TYPE5");
print FIC "  TYPE5 COURBEPOLYLINEAIRE_1_D\n";
print FIC " 	Debut_des_coordonnees_des_points\n";
print FIC " 	  Coordonnee dim= 2 0. 1.\n" if(abs($TEMPS[0]) > 1e-11);
foreach $temps (@TEMPS) {print FIC " 	  Coordonnee dim= 2 $temps 1.\n";}
print FIC "      Fin_des_coordonnees_des_points\n";
close(FIC);
print " > Le fichier $racine_fcalcul.TYPE5 a ete cree (typecharge de type TYPE5)...\n\n";
 
 
 
 
 
 
 
 
 
 
 
#
#
#
# le script s arrete la. Le reste, c est la definition des subroutines
#
#
#
 
 
 
#retourne le nombre de decimales d un reel
# entree : un reel
# sortie : nombre de decimale (un entier)
sub return_nb_decimales {
  my $nombre = shift;
  $nombre = abs($nombre);
  my $nb_decimales = 0;
  while() {
    last if($nombre >= 1);
    $nombre *= 10;
    $nb_decimales++;
  }
  return $nb_decimales;
}
 
 
#----------------
#sub qui lit un maillage herezh++ pour recuperer les noeuds, les elements et les listes de references
#et les renvoier sous forme de reference (lecture du .her et d un .lis si il existe)
#
# exemple d appel :
#  my ($nb_noeuds, $ref_tab_noeuds, $nb_elts, $ref_tab_elements, @ref_listes) = lecture_mail_her("fic_her");
#
#  avec - $nb_noeuds        : nombre de noeuds (entier)
#       - $ref_tab_noeuds   : reference vers un tableau de noeuds => $ref_tab_noeuds->[no noeud][0] : coordonnee x
#                                                                    $ref_tab_noeuds->[no noeud][1] : coordonnee y
#                                                                    $ref_tab_noeuds->[no noeud][2] : coordonnee z)
#       - $nb_elts          : nombre d elements (entier)
#       - $ref_tab_elements : reference vers une table de hashage => $ref_tab_elements->{no elt}{'TYPE'}      : type d element
#                                                                    @{$ref_tab_elements->{no elt}{'CONNEX'}} : (liste des noeuds)
#       - @ref_listes       : liste de references vers les tables de hashage contenant les listes de references de noeuds, aretes, faces et elements
#                             => $ref_listes[0] : reference vers la table de hashage des listes de noeuds  => @{$ref_listes[0]->{'nom liste'}} : (liste des noeuds)
#                                $ref_listes[1] : reference vers la table de hashage des listes d aretes   => @{$ref_listes[1]->{'nom liste'}} : (liste des aretes)
#                                $ref_listes[2] : reference vers la table de hashage des listes de faces   => @{$ref_listes[2]->{'nom liste'}} : (liste des faces)
#                                $ref_listes[3] : reference vers la table de hashage des listes d elements => @{$ref_listes[3]->{'nom liste'}} : (liste des elements)
#                                
sub lecture_mail_her {
  my $fher = shift;
 
  #------------------------
  # lecture du maillage .her
  #------------------------
  #-lecture de noeuds
  my @tab_noeuds; my $nb_noeuds;
  my $no_noeud = 0;
  open(Fher, "<$fher");
  while(<Fher>) {
    next if(not /(\d+)\s+NOEUDS/);
    $nb_noeuds = $1;
    last;
  }
  while(<Fher>) {
    last if($no_noeud == $nb_noeuds);
    next if(not /^\s*(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/);
    $no_noeud = $1;
    @{$tab_noeuds[$no_noeud]} = ($2,$3,$4);
  }
 
  #-lecture des elements
  my %tab_elements; my $nb_elts;
  my $no_elt = 0;
  while(<Fher>) {
    next if(not /(\d+)\s+ELEMENTS/);
    $nb_elts = $1;
    last;
  }
  while(<Fher>) {
    last if($no_elt == $nb_elts);
    next if(not /^\s*\d+\s+\w+\s+\w+/);
    s/^\s+//;s/\s+$//;
    $_ =~ /^(\d+)\s+/;
    $no_elt = $1; s/^(\d+)\s+//;
    $_ =~ /\s+(\d+(?:\s+\d+)*)$/;
    @{$tab_elements{$no_elt}{'CONNEX'}} = split(/\s+/, $1); s/\s+(\d+(?:\s+\d+)*)$//;
    $tab_elements{$no_elt}{'TYPE'} = $_; $tab_elements{$no_elt}{'TYPE'} =~ s/\s+/ /g;
  }
  close(Fher);
 
 
  #------------------------
  # lecture des references (dans le .her et dans un eventuel .lis)
  #------------------------
  my $flis = $fher; $flis =~ s/.her$/.lis/;
  my $nom_liste;
  my $is_liste_en_cours;
  my %listes_NOEUDS;
  my %listes_ARETES;
  my %listes_FACES;
  my %listes_ELEMENTS;
 
  #-dans le .her
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
  open(Fher, "<$fher");
  $is_liste_en_cours = 0;
  while(<Fher>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Fher);
 
 
  #dans le .lis (si il existe)
  if(-e $flis) {
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(N\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*N\S+\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[AFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_NOEUDS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(A\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*A\S+\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NFE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ARETES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(F\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*F\S+\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAE]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_FACES{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  open(Flis, "<$flis");
  $is_liste_en_cours = 0;
  while(<Flis>) {
    chomp;
    if(/^\s*(E\S+)/) {
      $nom_liste = $1;
      $is_liste_en_cours = 1;
      s/^\s*E\S+\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
    elsif(/^\s*noeuds/i or /^\s*elements/i or /^\s*[NAF]/) {
      $is_liste_en_cours = 0;
    }
    elsif($is_liste_en_cours and /^\s*\d+(\s+\d+)*\s*$/i) {
      s/^\s+//; s/\s+$//;
      push(@{$listes_ELEMENTS{$nom_liste}},split(/\s+/,$_));
    }
  }
  close(Flis);
 
  }#if(-e $flis)
 
  #AFFICHAGE DES LISTES DE NOEUDS
  #foreach my $nom (keys(%listes_NOEUDS)) {
  #  print "$nom : @{$listes_NOEUDS{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES D ARETES
  #foreach my $nom (keys(%listes_ARETES)) {
  #  print "$nom : @{$listes_ARETES{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES DE FACES
  #foreach my $nom (keys(%listes_FACES)) {
  #  print "$nom : @{$listes_FACES{$nom}}\n";
  #}
  #AFFICHAGE DES LISTES D ELEMENTS
  #foreach my $nom (keys(%listes_ELEMENTS)) {
  #  print "$nom : @{$listes_ELEMENTS{$nom}}\n";
  #}
 
  return($nb_noeuds, \@tab_noeuds, $nb_elts, \%tab_elements,
         \%listes_NOEUDS, \%listes_ARETES,
         \%listes_FACES, \%listes_ELEMENTS);
}#sub lecture_mail_her

Code de tri du fichier .courbes (en reprenant une stratégie tell-seek car le fichier .courbes peut être gros) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
#!/usr/bin/env perl
use strict;
use warnings;
 
 
my $fcourbes = shift(@ARGV); (-e $fcourbes) or die "\nErreur : fichier $fcourbes introuvable...\n\n";
 
my @liste_noeud;
my @TAB_TELL;
open(FIC, "<$fcourbes") or die "pb fichier $fcourbes : $!\n";
while() {
  my $tell = tell(FIC);
  last if(not $_ = <FIC>);
  next if(not /UX_noeud_(\d+)/o);
  push(@liste_noeud, $1);
  $TAB_TELL[$liste_noeud[$#liste_noeud]] = $tell;
}
close(FIC);
@liste_noeud = sort {$a <=> $b} @liste_noeud;
 
open(FIC, "<$fcourbes");
open(FIC2, ">$fcourbes.tri");
foreach my $noeud (@liste_noeud) {
  print FIC2 "\n";
  seek(FIC, $TAB_TELL[$noeud], 0);
  $_ = <FIC>;
  print FIC2;
  my $nb_fin_coord = 0;
  while(<FIC>) {
    $nb_fin_coord++ if(/Fin_des_coor/);
    last if(/UX_noeud_/o);
    print FIC2;
    last if($nb_fin_coord == 3);
  }
}
close(FIC);
close(FIC2);
 
print "Le fichier $fcourbes.tri a ete cree...\n\n";

**Philou67430** · 05/10/2015, 17h35

Dans ma version "tout en mémoire", la fin de chargement du fichier fdpl_1.pos ne signifie pas la fin de l'occupation mémoire : en effet, la construction des fichiers temporaire est également mise en mémoire au lieu d'être "écrite" dans des fichiers réel puis concaténés. C'est la raison pour laquelle la mémoire continue de monter jusqu'à la libération finale (c'est à dire que le fichier .courbes est écrit).

**seagull** · 05/10/2015, 18h06

ah oui effectivement je n'avais pas compris.

**Philou67430** · 06/10/2015, 11h24

Je suppose que l'on peut arrêter là les investigations ? en tout cas, ça m'a intéressé.

**seagull** · 07/10/2015, 13h28

intérêt partagé. J'ai appris plein de trucs.

si je suis intéressé par les BDD, j'ouvrirai un autre sujet dédié.

compte-tenu de la demande initiale, je ne sais pas si on peut mettre [résolu]. En tout cas, on pourrait mettre [satisfait] :-)

améliorer performance script

Langage Perl

Discussions similaires

Partager

Partager