1 subroutine deinri ( pilraf, pilder,
2 > typseh, typseb, seuilh, seuilb, nbsoci,
4 > nbvpen, nbvpyr, nbvhex, nbvtet,
5 > nbvqua, nbvtri, nbvare, nbvnoe,
6 > nosupp, noindr, noindi,
7 > arsupp, arindr, arindi,
8 > trsupp, trindr, trindi,
9 > qusupp, quindr, quindi,
10 > tesupp, teindr, teindi,
11 > hesupp, heindr, heindi,
12 > pysupp, pyindr, pyindi,
13 > pesupp, peindr, peindi,
14 > ulsort, langue, codret)
15 c ______________________________________________________________________
19 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
21 c Version originale enregistree le 18 juin 1996 sous le numero 96036
22 c aupres des huissiers de justice Simart et Lavoir a Clamart
23 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
24 c aupres des huissiers de justice
25 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
27 c HOMARD est une marque deposee d'Electricite de France
33 c ______________________________________________________________________
35 c traitement des DEcisions - INitialisation de l'indicateur
37 c passage de Reel a entIer
39 c ______________________________________________________________________
41 c remarque : il faut filtrer par les supports pour les endroits ou
42 c la valeur de l'indicateur est indefinie. mettre une
43 c valeur "moyenne" ne permet pas de passer certains cas
44 c biscornus a cause des .le. ou .lt.
45 c ______________________________________________________________________
47 c . nom . e/s . taille . description .
48 c .____________________________________________________________________.
49 c . pilraf . e . 1 . pilotage du raffinement .
50 c . . . . -1 : raffinement uniforme .
51 c . . . . 0 : pas de raffinement .
52 c . . . . 1 : raffinement libre .
53 c . . . . 2 : raff. libre homogene en type d'element.
54 c . pilder . e . 1 . pilotage du deraffinement .
55 c . . . . 0 : pas de deraffinement .
56 c . . . . 1 : deraffinement libre .
57 c . . . . -1 : deraffinement uniforme .
58 c . typseh . e . 1 . type de seuil haut .
59 c . . . . 1 : absolu .
60 c . . . . 2 : relatif .
61 c . . . . 3 : pourcentage d'entites .
62 c . . . . 4 : moyenne + nh*ecart-type .
63 c . . . . 5 : cible en nombre de noeuds .
64 c . typseb . e . 1 . type de seuil bas .
65 c . . . . 1 : absolu .
66 c . . . . 2 : relatif .
67 c . . . . 3 : pourcentage d'entites .
68 c . . . . 4 : moyenne - nb*ecart-type .
69 c . seuilh . es . 1 . borne superieure de l'erreur (absolue, .
70 c . . . . relatif, pourcentage d'entites ou nh) .
71 c . seuilb . e . 1 . borne inferieure de l'erreur (absolue, .
72 c . . . . relatif, pourcentage d'entites ou nb) .
73 c . nbsoci . e . 1 . cible en nombre de sommets (-1 si non) .
74 c . usacmp . e . 1 . usage des composantes de l'indicateur .
75 c . . . . 0 : norme L2 .
76 c . . . . 1 : norme infinie -max des valeurs absolues.
77 c . . . . 2 : valeur relative si une seule composante.
78 c . nbvpen . e . 1 . nombre de valeurs par pentaedres .
79 c . nbvpyr . e . 1 . nombre de valeurs par pyramides .
80 c . nbvhex . e . 1 . nombre de valeurs par hexaedres .
81 c . nbvtet . e . 1 . nombre de valeurs par tetraedres .
82 c . nbvqua . e . 1 . nombre de valeurs par quadrangles .
83 c . nbvtri . e . 1 . nombre de valeurs par triangles .
84 c . nbvare . e . 1 . nombre de valeurs par aretes .
85 c . nbvnoe . e . 1 . nombre de valeurs par noeuds .
86 c . nosupp . e . nbnoto . support pour les noeuds .
87 c . noindr . e . nbnoto . valeurs reelles pour les noeuds .
88 c . noindi . s . nbnoto . valeurs entieres pour les noeuds .
89 c . arsupp . e . nbarto . support pour les aretes .
90 c . arindr . es . nbarto . valeurs reelles pour les aretes .
91 c . arindi . s . nbarto . valeurs entieres pour les aretes .
92 c . trsupp . e . nbtrto . support pour les triangles .
93 c . trindr . es . nbtrto . valeurs reelles pour les triangles .
94 c . trindi . s . nbtrto . valeurs entieres pour les triangles .
95 c . qusupp . e . nbquto . support pour les quadrangles .
96 c . quindr . es . nbquto . valeurs reelles pour les quadrangles .
97 c . quindi . s . nbquto . valeurs entieres pour les quadrangles .
98 c . tesupp . e . nbteto . support pour les tetraedres .
99 c . teindr . es . nbteto . valeurs reelles pour les tetraedres .
100 c . teindi . s . nbteto . valeurs entieres pour les tetraedres .
101 c . hesupp . e . nbheto . support pour les hexaedres .
102 c . heindr . es . nbheto . valeurs reelles pour les hexaedres .
103 c . heindi . s . nbheto . valeurs entieres pour les hexaedres .
104 c . pysupp . e . nbpyto . support pour les pyramides .
105 c . pyindr . es . nbpyto . valeurs reelles pour les pyramides .
106 c . pyindi . s . nbpyto . valeurs entieres pour les pyramides .
107 c . pesupp . e . nbpeto . support pour les pentaedres .
108 c . peindr . es . nbpeto . valeurs reelles pour les pentaedres .
109 c . peindi . s . nbpeto . valeurs entieres pour les pentaedres .
110 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
111 c . langue . e . 1 . langue des messages .
112 c . . . . 1 : francais, 2 : anglais .
113 c . codret . es . 1 . code de retour des modules .
114 c . . . . 0 : pas de probleme .
115 c . . . . 2 : probleme dans le traitement .
116 c ______________________________________________________________________
119 c 0. declarations et dimensionnement
122 c 0.1. ==> generalites
128 parameter ( nompro = 'DEINRI' )
148 integer pilraf, pilder
149 integer typseh, typseb
152 integer nbvpen, nbvpyr, nbvhex, nbvtet
153 integer nbvqua, nbvtri, nbvare, nbvnoe
155 integer nosupp(nbnoto), noindi(nbnoto)
156 integer arsupp(nbarto), arindi(nbarto)
157 integer trsupp(nbtrto), trindi(nbtrto)
158 integer qusupp(nbquto), quindi(nbquto)
159 integer tesupp(nbteto), teindi(nbteto)
160 integer hesupp(nbheto), heindi(nbheto)
161 integer pysupp(nbpyto), pyindi(nbpyto)
162 integer pesupp(nbpeto), peindi(nbpeto)
164 integer ulsort, langue, codret
166 double precision seuilb, seuilh
167 double precision noindr(nbnoto)
168 double precision arindr(nbarto)
169 double precision trindr(nbtrto)
170 double precision quindr(nbquto)
171 double precision teindr(nbteto)
172 double precision heindr(nbheto)
173 double precision pyindr(nbpyto)
174 double precision peindr(nbpeto)
176 c 0.4. ==> variables locales
180 integer typenh, typen0
184 double precision seuihe, seuibe
189 parameter (nbmess = 10 )
190 character*80 texte(nblang,nbmess)
191 c ______________________________________________________________________
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,texte(langue,1)) 'Entree', nompro
207 c 2. allocation de tableaux temporaires
211 if ( nbvnoe.ne.0 ) then
214 if ( nbvare.ne.0 ) then
217 if ( nbvtri.ne.0 ) then
220 if ( nbvqua.ne.0 ) then
223 if ( nbvtet.ne.0 ) then
226 if ( nbvpyr.ne.0 ) then
229 if ( nbvhex.ne.0 ) then
232 if ( nbvpen.ne.0 ) then
236 call gmalot ( ntrav1, 'reel ', iaux, ptrav1, codre0 )
238 codret = max ( abs(codre0), codret )
241 c 3. traitement des indicateurs
243 #ifdef _DEBUG_HOMARD_
244 write (ulsort,90002) '3. traitement indicateurs ; codret', codret
252 if ( nbvnoe.ne.0 ) then
254 if ( codret.eq.0 ) then
256 #ifdef _DEBUG_HOMARD_
257 write (ulsort,texte(langue,3)) 'DEINTI_no', nompro
260 call deinti ( typenh,
261 > usacmp, nbnoto, nosupp, noindr,
262 > indtab, rmem(ptrav1),
263 > ulsort, langue, codret)
272 if ( nbvare.ne.0 ) then
274 if ( codret.eq.0 ) then
276 #ifdef _DEBUG_HOMARD_
277 write (ulsort,texte(langue,3)) 'DEINTI_ar', nompro
280 call deinti ( typenh,
281 > usacmp, nbarto, arsupp, arindr,
282 > indtab, rmem(ptrav1),
283 > ulsort, langue, codret)
284 if ( typen0.eq.-2 ) then
296 if ( nbvtri.ne.0 ) then
298 if ( codret.eq.0 ) then
300 #ifdef _DEBUG_HOMARD_
301 write (ulsort,texte(langue,3)) 'DEINTI_tr', nompro
304 call deinti ( typenh,
305 > usacmp, nbtrto, trsupp, trindr,
306 > indtab, rmem(ptrav1),
307 > ulsort, langue, codret)
308 if ( typen0.eq.-2 ) then
318 c 3.4. ==> quadrangles
320 if ( nbvqua.ne.0 ) then
322 if ( codret.eq.0 ) then
324 #ifdef _DEBUG_HOMARD_
325 write (ulsort,texte(langue,3)) 'DEINTI_qu', nompro
328 call deinti ( typenh,
329 > usacmp, nbquto, qusupp, quindr,
330 > indtab, rmem(ptrav1),
331 > ulsort, langue, codret)
332 if ( typen0.eq.-2 ) then
334 elseif ( typen0.eq.2 ) then
344 c 3.5. ==> tetraedres
346 if ( nbvtet.ne.0 ) then
348 if ( codret.eq.0 ) then
350 #ifdef _DEBUG_HOMARD_
351 write (ulsort,texte(langue,3)) 'DEINTI_te', nompro
354 call deinti ( typenh,
355 > usacmp, nbteto, tesupp, teindr,
356 > indtab, rmem(ptrav1),
357 > ulsort, langue, codret)
358 if ( typen0.eq.-2 ) then
370 if ( nbvpyr.ne.0 ) then
372 if ( codret.eq.0 ) then
374 #ifdef _DEBUG_HOMARD_
375 write (ulsort,texte(langue,3)) 'DEINTI_py', nompro
378 call deinti ( typenh,
379 > usacmp, nbpyto, pysupp, pyindr,
380 > indtab, rmem(ptrav1),
381 > ulsort, langue, codret)
382 if ( typen0.eq.-2 ) then
384 elseif ( typen0.eq.3 ) then
396 if ( nbvhex.ne.0 ) then
398 if ( codret.eq.0 ) then
400 #ifdef _DEBUG_HOMARD_
401 write (ulsort,texte(langue,3)) 'DEINTI_he', nompro
404 call deinti ( typenh,
405 > usacmp, nbheto, hesupp, heindr,
406 > indtab, rmem(ptrav1),
407 > ulsort, langue, codret)
408 if ( typen0.eq.-2 ) then
410 elseif ( typen0.eq.3 .or. typen0.eq.5 .or. typen0.eq.9 ) then
420 c 3.8. ==> pentaedres
422 if ( nbvpen.ne.0 ) then
424 if ( codret.eq.0 ) then
426 #ifdef _DEBUG_HOMARD_
427 write (ulsort,texte(langue,3)) 'DEINTI_pe', nompro
430 call deinti ( typenh,
431 > usacmp, nbpeto, pesupp, peindr,
432 > indtab, rmem(ptrav1),
433 > ulsort, langue, codret)
434 if ( typen0.eq.-2 ) then
436 elseif ( typen0.eq.3 .or. typen0.eq.5 .or.
437 > typen0.eq.6 .or. typen0.eq.9 ) then
448 c 4. determination du seuil
450 #ifdef _DEBUG_HOMARD_
451 write (ulsort,90002) '4. determination du seuil ; codret', codret
453 cgn call gmprsx (nompro, ntrav1 )
455 if ( codret.eq.0 ) then
457 #ifdef _DEBUG_HOMARD_
458 write (ulsort,texte(langue,3)) 'DEINSE', nompro
461 call deinse ( typen0,
464 > typseh, typseb, seuilh, seuilb, nbsoci,
465 > indtab, rmem(ptrav1),
466 > ulsort, langue, codret)
471 c 5. transfert de reel a entier
473 #ifdef _DEBUG_HOMARD_
474 write (ulsort,90002) '5. transfert reel/entier ; codret', codret
478 if ( nbvnoe.ne.0 ) then
480 if ( codret.eq.0 ) then
482 #ifdef _DEBUG_HOMARD_
483 write (ulsort,texte(langue,3)) 'DEINST_no', nompro
486 call deinst ( typenh,
488 > nbnoto, nosupp, noindr, noindi,
489 > ulsort, langue, codret)
497 if ( nbvare.ne.0 ) then
499 if ( codret.eq.0 ) then
501 #ifdef _DEBUG_HOMARD_
502 write (ulsort,texte(langue,3)) 'DEINST_ar', nompro
505 call deinst ( typenh,
507 > nbarto, arsupp, arindr, arindi,
508 > ulsort, langue, codret)
516 if ( nbvtri.ne.0 ) then
518 if ( codret.eq.0 ) then
520 #ifdef _DEBUG_HOMARD_
521 write (ulsort,texte(langue,3)) 'DEINST_tr', nompro
524 call deinst ( typenh,
526 > nbtrto, trsupp, trindr, trindi,
527 > ulsort, langue, codret)
533 c 5.4. ==> quadrangles
535 if ( nbvqua.ne.0 ) then
537 if ( codret.eq.0 ) then
539 #ifdef _DEBUG_HOMARD_
540 write (ulsort,texte(langue,3)) 'DEINST_qu', nompro
543 call deinst ( typenh,
545 > nbquto, qusupp, quindr, quindi,
546 > ulsort, langue, codret)
552 c 5.5. ==> tetraedres
554 if ( nbvtet.ne.0 ) then
556 if ( codret.eq.0 ) then
558 #ifdef _DEBUG_HOMARD_
559 write (ulsort,texte(langue,3)) 'DEINST_te', nompro
562 call deinst ( typenh,
564 > nbteto, tesupp, teindr, teindi,
565 > ulsort, langue, codret)
573 if ( nbvpyr.ne.0 ) then
575 if ( codret.eq.0 ) then
577 #ifdef _DEBUG_HOMARD_
578 write (ulsort,texte(langue,3)) 'DEINST_py', nompro
581 call deinst ( typenh,
583 > nbpyto, pysupp, pyindr, pyindi,
584 > ulsort, langue, codret)
592 if ( nbvhex.ne.0 ) then
594 if ( codret.eq.0 ) then
596 #ifdef _DEBUG_HOMARD_
597 write (ulsort,texte(langue,3)) 'DEINST_he', nompro
600 call deinst ( typenh,
602 > nbheto, hesupp, heindr, heindi,
603 > ulsort, langue, codret)
609 c 5.8. ==> pentaedres
611 if ( nbvpen.ne.0 ) then
613 if ( codret.eq.0 ) then
615 #ifdef _DEBUG_HOMARD_
616 write (ulsort,texte(langue,3)) 'DEINST_pe', nompro
619 call deinst ( typenh,
621 > nbpeto, pesupp, peindr, peindi,
622 > ulsort, langue, codret)
629 c 6. liberation des tableaux temporaires
631 #ifdef _DEBUG_HOMARD_
632 write (ulsort,90002) '6. liberation ; codret', codret
635 if ( codret.eq.0 ) then
637 call gmlboj ( ntrav1 , codre0 )
639 codret = max ( abs(codre0), codret )
648 if ( codret.ne.0 ) then
652 write (ulsort,texte(langue,1)) 'Sortie', nompro
653 write (ulsort,texte(langue,2)) codret
657 #ifdef _DEBUG_HOMARD_
658 write (ulsort,texte(langue,1)) 'Sortie', nompro