1 subroutine utntet ( letetr, niveau,
2 > tritet, pertet, pthepe,
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire : Niveau d'un TETraedre
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . letetr . e . 1 . numero du tetraedre a examiner .
32 c . niveau . s . 1 . niveau .
33 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
34 c . pertet . e . nbteto . pere des tetraedres .
35 c . . . . si pertet(i) > 0 : numero du tetraedre .
36 c . . . . si pertet(i) < 0 : -numero dans pthepe .
37 c . pthepe . e . * . si i <= nbheco : numero de l'hexaedre .
38 c . . . . si non : numero du pentaedre .
39 c . nivtri . e . nbtrto . niveau dans le raffinement/deraffinement .
40 c . nivqua . e . nbquto . niveau dans le raffinement/deraffinement .
41 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
42 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
43 c .____________________________________________________________________.
46 c 0. declarations et dimensionnement
49 c 0.1. ==> generalites
64 double precision niveau
67 integer nivtri(nbtrto), nivqua(nbquto)
68 integer tritet(nbtecf,4), pertet(nbteto), pthepe(*)
69 integer quahex(nbhecf,6)
70 integer facpen(nbpecf,5)
72 c 0.4. ==> variables locales
74 integer lafac1, lafac2, lafac3, lafac4, lafac5, lafac6
78 c 0.5. ==> initialisations
83 c 1. Determination du niveau
86 cgn write(*,90002) 'nbtema, nbtecf, nbteto', nbtema, nbtecf, nbteto
87 cgn write(*,90002) 'letetr', letetr
89 c 1.1. ==> Du maillage initial
91 if ( letetr.le.nbtema ) then
99 c 1.2.1. ==> Si le tetraedre est decrit par faces :
100 c le plus haut niveau de ses faces
102 if ( letetr.le.nbtecf ) then
104 lafac1 = tritet(letetr,1)
105 lafac2 = tritet(letetr,2)
106 lafac3 = tritet(letetr,3)
107 lafac4 = tritet(letetr,4)
108 jaux = max(nivtri(lafac1),nivtri(lafac2),
109 > nivtri(lafac3),nivtri(lafac4))
111 c 1.2.2. ==> Si le tetraedre est decrit par aretes :
112 c son niveau est le niveau du pere augmente d'un cran
116 iaux = pertet(letetr)
117 lepere = pthepe(-iaux)
118 cgn write(*,90002) 'iaux, lepere', iaux, lepere
119 cgn write(*,90002) 'nbheco', nbheco
121 if ( -iaux.le.nbheco ) then
123 lafac1 = quahex(lepere,1)
124 lafac2 = quahex(lepere,2)
125 lafac3 = quahex(lepere,3)
126 lafac4 = quahex(lepere,4)
127 lafac5 = quahex(lepere,5)
128 lafac6 = quahex(lepere,6)
129 jaux = max(nivqua(lafac1),nivqua(lafac2),nivqua(lafac3),
130 > nivqua(lafac4),nivqua(lafac5),nivqua(lafac6))
133 lafac1 = facpen(lepere,1)
134 lafac2 = facpen(lepere,2)
135 lafac3 = facpen(lepere,3)
136 lafac4 = facpen(lepere,4)
137 lafac5 = facpen(lepere,5)
138 jaux = max(nivtri(lafac1),nivtri(lafac2),
139 > nivqua(lafac3),nivqua(lafac4),nivqua(lafac5))
147 cgn write(*,90002) '==> jaux',jaux
150 c 1.2.3. ==> Si le tetraedre est de conformite, on prend le niveau
151 c intermediaire immediatement inferieur
153 if ( letetr.gt.nbtepe ) then
154 niveau = niveau - 0.5d0
158 cgn write(*,90004) '==> niveau',niveau