1 subroutine utb3g0 ( hetnoe, coonoe,
2 > numcoi, coinpt, coinnn,
5 > hetpen, facpen, cofape, arepen, 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 G0
30 c ______________________________________________________________________
32 c but : controle l'interpenetration des pentaedres
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 . hetpen . e . nbpeto . historique de l'etat des pentaedres .
46 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
47 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
48 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
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 = 'UTB3G0' )
74 parameter ( typenh = 7 )
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 facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
96 integer hetpen(nbpeto)
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 lepent, lenoeu
110 integer nucoin, ptcoin, ptcode, ptcofi
111 integer sommet(15), nbsomm
113 #ifdef _DEBUG_HOMARD_
117 double precision v0(5,3)
118 double precision v1(3), v2(3), v3(3), v4(3), v5(3), v6(3)
119 double precision v12(3), v13(3), v14(3)
120 double precision v52(3), v54(3), v56(3)
121 double precision vn(3)
122 double precision xmax, xmin, ymax, ymin, zmax, zmin
123 double precision prmito, prmilo
124 double precision daux1
129 parameter (nbmess = 10 )
130 character*80 texte(nblang,nbmess)
132 c 0.5. ==> initialisations
133 c ______________________________________________________________________
143 #ifdef _DEBUG_HOMARD_
144 write (ulsort,texte(langue,1)) 'Entree', nompro
152 c 1.2. ==> constantes
156 if ( degre.eq.1 ) then
163 c 2. controle de la non-interpenetration des pentaedres
164 c remarque : on ne s'interesse qu'aux actifs car les autres sont
165 c censes avoir ete controles aux iterations anterieures
169 do 20 , lepent = 1 , nbpeto
171 #ifdef _DEBUG_HOMARD_
172 if ( lepent.lt.0 ) then
179 if ( mod(hetpen(lepent),100).eq.0 ) then
182 if ( nbpbco(typenh).eq.-1 ) then
183 #ifdef _DEBUG_HOMARD_
184 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
191 #ifdef _DEBUG_HOMARD_
192 if ( glop.ne.0 ) then
193 write (ulsort,14203) sommet(1), v1(1), v1(2), v1(3)
194 write (ulsort,14203) sommet(2), v2(1), v2(2), v2(3)
195 write (ulsort,14203) sommet(3), v3(1), v3(2), v3(3)
196 write (ulsort,14203) sommet(4), v4(1), v4(2), v4(3)
197 write (ulsort,14203) sommet(5), v5(1), v5(2), v5(3)
198 write (ulsort,14203) sommet(6), v6(1), v6(2), v6(3)
199 write (ulsort,*) xmin, xmax
200 write (ulsort,*) ymin, ymax
201 write (ulsort,*) zmin, zmax
205 do 23 , lenoeu = numip1, numap1
215 c 2.3.9. ==> si logaux(7) est encore vrai, c'est que le noeud est
216 c a l'interieur du pentaedre ... malaise ...
218 if ( logaux(7) ) then
224 write (ulbila,14203) sommet(1), v1(1), v1(2), v1(3)
225 write (ulbila,14203) sommet(2), v2(1), v2(2), v2(3)
226 write (ulbila,14203) sommet(3), v3(1), v3(2), v3(3)
227 write (ulbila,14203) sommet(4), v4(1), v4(2), v4(3)
228 write (ulbila,14203) sommet(5), v5(1), v5(2), v5(3)
229 write (ulbila,14203) sommet(6), v6(1), v6(2), v6(3)