1 subroutine utb3e0 ( hetnoe, coonoe,
2 > numcoi, coinpt, coinnn,
5 > hethex, quahex, coquhe, arehex, np2are,
6 > nbpbco, mess08, mess54,
7 > ulbila, ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c UTilitaire - Bilan - option 3 - phase E0
30 c ______________________________________________________________________
32 c but : controle l'interpenetration des hexaedres
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . hetnoe . e . nbnoto . historique de l'etat des noeuds .
38 c . coonoe . e . nbnoto . coordonnees des noeuds .
40 c . numcoi . e . nbnoto . numero de la coincidence du noeud .
41 c . coinpt . e . * . pointeur de la i-eme coincidence dans coinn.
42 c . coinnn . e . * . liste des noeuds coincidents .
43 c . somare . e .2*nbarto. numeros des extremites d'arete .
44 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
45 c . hethex . e . nbheto . historique de l'etat des hexaedres .
46 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
47 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
48 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
49 c . np2are . e . nbarto . noeud milieux des aretes .
50 c . nbpbco . es . -1:7 . nombre de problemes de coincidences .
51 c . mess54 . e .nblang,*. messages .
52 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
53 c . ulsort . e . 1 . unite logique de la sortie generale .
54 c . langue . e . 1 . langue des messages .
55 c . . . . 1 : francais, 2 : anglais .
56 c . codret . s . 1 . code de retour des modules .
57 c . . . . 0 : pas de probleme .
58 c . . . . 1 : probleme .
59 c .____________________________________________________________________.
62 c 0. declarations et dimensionnement
65 c 0.1. ==> generalites
71 parameter ( nompro = 'UTB3E0' )
74 parameter ( typenh = 6 )
89 double precision coonoe(nbnoto,sdim)
91 integer hetnoe(nbnoto)
92 integer numcoi(nbnoto), coinpt(*), coinnn(*)
93 integer somare(2,nbarto)
94 integer arequa(nbquto,4)
95 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
96 integer hethex(nbheto)
97 integer np2are(nbarto)
100 character*08 mess08(nblang,*)
101 character*54 mess54(nblang,*)
104 integer ulsort, langue, codret
106 c 0.4. ==> variables locales
109 integer lehexa, lenoeu
110 integer nucoin, ptcoin, ptcode, ptcofi
111 integer sommet(20), nbsomm
114 double precision v0(6,3)
115 double precision v1(3), v2(3), v3(3), v4(3)
116 double precision v5(3), v6(3), v7(3), v8(3)
117 double precision v12(3), v14(3), v16(3)
118 double precision v83(3), v85(3), v87(3)
119 double precision vn(3)
120 double precision xmax, xmin, ymax, ymin, zmax, zmin
121 double precision prmito, prmilo
122 double precision daux1
127 parameter (nbmess = 10 )
128 character*80 texte(nblang,nbmess)
130 c 0.5. ==> initialisations
132 #ifdef _DEBUG_HOMARD_
136 c ______________________________________________________________________
146 #ifdef _DEBUG_HOMARD_
147 write (ulsort,texte(langue,1)) 'Entree', nompro
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,90002) 'nbpbco', nbpbco
161 c 1.2. ==> constantes
165 if ( degre.eq.1 ) then
170 #ifdef _DEBUG_HOMARD_
171 write (ulsort,90002) 'nbheto', nbheto
172 write (ulsort,90002) 'nbhecf', nbhecf
173 write (ulsort,90002) 'degre ', degre
177 c 2. controle de la non-interpenetration des hexaedres
178 c remarque : on ne s'interesse qu'aux actifs car les autres sont
179 c censes avoir ete controles aux iterations anterieures
183 do 20 , lehexa = 1 , nbheto
185 #ifdef _DEBUG_HOMARD_
186 if ( lehexa.lt.0 ) then
189 write (ulsort,90002) mess14(langue,1,typenh), lehexa
190 write (ulsort,90112) 'etat', lehexa,hethex(lehexa)
191 cgn write (ulsort,90112) 'nbpbco', typenh,nbpbco(typenh)
197 if ( mod(hethex(lehexa),1000).eq.0 ) then
199 #ifdef _DEBUG_HOMARD_
200 if ( glop.ne.0 ) then
201 write (ulsort,90112) nompro//' quahex', lehexa,
202 > (quahex(lehexa,iaux),iaux=1,6)
203 write (ulsort,90112) nompro//' coquhe', lehexa,
204 > (coquhe(lehexa,iaux),iaux=1,6)
208 if ( nbpbco(typenh).eq.-1 ) then
209 #ifdef _DEBUG_HOMARD_
210 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
217 #ifdef _DEBUG_HOMARD_
218 if ( glop.ne.0 ) then
219 write (ulsort,14203) sommet(1), v1(1), v1(2), v1(3)
220 write (ulsort,14203) sommet(2), v2(1), v2(2), v2(3)
221 write (ulsort,14203) sommet(3), v3(1), v3(2), v3(3)
222 write (ulsort,14203) sommet(4), v4(1), v4(2), v4(3)
223 write (ulsort,14203) sommet(5), v5(1), v5(2), v5(3)
224 write (ulsort,14203) sommet(6), v6(1), v6(2), v6(3)
225 write (ulsort,14203) sommet(7), v7(1), v7(2), v7(3)
226 write (ulsort,14203) sommet(8), v8(1), v8(2), v8(3)
227 write (ulsort,90004) 'X min/max', xmin, xmax
228 write (ulsort,90004) 'Y min/max', ymin, ymax
229 write (ulsort,90004) 'Z min/max', zmin, zmax
230 write (ulsort,90002) 'numip1, numap1',numip1, numap1
234 do 23 , lenoeu = numip1, numap1
237 #ifdef _DEBUG_HOMARD_
238 if ( glop.ne.0 .and. lenoeu.lt.0 ) then
239 write (ulsort,*) 'apres utb304', logaux(7)
240 write (ulsort,90004) 'vn', vn
245 #ifdef _DEBUG_HOMARD_
246 if ( glop.ne.0 .and. lenoeu.lt.0 ) then
247 write (ulsort,*) 'apres utb305', logaux(7)
252 #ifdef _DEBUG_HOMARD_
253 if ( glop.ne.0 .and. lenoeu.lt.0 ) then
254 write (ulsort,*) 'apres utb306', logaux(7)
259 #ifdef _DEBUG_HOMARD_
260 if ( glop.ne.0 .and. lenoeu.lt.0 ) then
261 write (ulsort,*) 'apres utb3e2', logaux(7)
265 c 2.3.9. ==> si logaux(7) est encore vrai, c'est que le noeud est
266 c a l'interieur de l'hexaedre ... malaise ...
268 if ( logaux(7) ) then
274 write (ulbila,14203) sommet(1), v1(1), v1(2), v1(3)
275 write (ulbila,14203) sommet(2), v2(1), v2(2), v2(3)
276 write (ulbila,14203) sommet(3), v3(1), v3(2), v3(3)
277 write (ulbila,14203) sommet(4), v4(1), v4(2), v4(3)
278 write (ulbila,14203) sommet(5), v5(1), v5(2), v5(3)
279 write (ulbila,14203) sommet(6), v6(1), v6(2), v6(3)
280 write (ulbila,14203) sommet(7), v7(1), v7(2), v7(3)
281 write (ulbila,14203) sommet(8), v8(1), v8(2), v8(3)
298 #ifdef _DEBUG_HOMARD_
299 write (ulsort,90002) 'nbpbco', nbpbco
302 #ifdef _DEBUG_HOMARD_
303 write (ulsort,texte(langue,1)) 'Sortie', nompro