1 subroutine pcmate ( elemen, nbele0,
4 > tritet, cotrte, aretet,
5 > hettet, famtet, cfatet,
6 > nnosca, ntesca, ntesho,
7 > famele, noeele, typele,
8 > ulsort, langue, codret )
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c aPres adaptation - Conversion - MAillage connectivite - TEtraedres
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . elemen . es . 1 . numero du dernier element cree .
36 c . nbele0 . e . 1 . estimation du nombre d'elements .
37 c . somare . e .2*nbarto. numeros des extremites d'arete .
38 c . np2are . e . nbarto . numero du noeud p2 milieu d'arete .
39 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
40 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
41 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
42 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
43 c . hettet . e . nbteto . historique de l'etat des tetraedres .
44 c . famtet . e . nbteto . famille des tetraedres .
45 c . cfatet . . nctfte. codes des familles des tetraedres .
46 c . . . nbftet . 1 : famille MED .
47 c . . . . 2 : type de tetraedres .
48 c . . . . + l : appartenance a l'equivalence l .
49 c . nnosca . e . rsnoto . numero des noeuds du code de calcul .
50 c . ntesca . s . rsteto . numero des tetraedres du calcul .
51 c . ntesho . s . nbele0 . numero des tetraedres dans HOMARD .
52 c . famele . es . nbele0 . famille med des elements .
53 c . noeele . es . nbele0 . noeuds des elements .
55 c . typele . es . nbele0 . type des elements .
56 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
57 c . langue . e . 1 . langue des messages .
58 c . . . . 1 : francais, 2 : anglais .
59 c . codret . es . 1 . code de retour des modules .
60 c . . . . 0 : pas de probleme .
61 c . . . . 1 : probleme .
62 c ______________________________________________________________________
65 c 0. declarations et dimensionnement
68 c 0.1. ==> generalites
74 parameter ( nompro = 'PCMATE' )
100 integer somare(2,nbarto), np2are(nbarto)
101 integer aretri(nbtrto,3)
102 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
103 integer hettet(nbteto)
105 integer cfatet(nctfte,nbftet), famtet(nbteto)
107 integer nnosca(rsnoto)
108 integer ntesca(rsteto), ntesho(nbele0)
110 integer famele(nbele0), noeele(nbele0,nbmane)
111 integer typele(nbele0)
113 integer ulsort, langue, codret
115 c 0.4. ==> variables locales
117 integer letetr, letet0
120 integer listar(6), listso(4)
123 parameter ( nbmess = 20 )
124 character*80 texte(nblang,nbmess)
126 c 0.5. ==> initialisations
127 c ______________________________________________________________________
139 #ifdef _DEBUG_HOMARD_
140 write (ulsort,texte(langue,1)) 'Entree', nompro
144 #ifdef _DEBUG_HOMARD_
145 write(ulsort,90002) 'nbtecf, nbteca =', nbtecf, nbteca
151 c 2. initialisations des renumerotations
154 do 21 , iaux = 1 , rsteto
158 do 22 , iaux = 1 , nbele0
163 c 3. Conversion en lineaire
166 if ( degre.eq.1 ) then
168 c la face fi est opposee au sommet ni
182 c *..................................*
185 do 31 , letet0 = 1 , nbteto
189 #ifdef _DEBUG_HOMARD_
190 write (ulsort,texte(langue,11)) mess14(langue,2,3), letetr
193 etat = mod( hettet(letetr) , 100 )
195 if ( etat.eq.0 .or. hierar.ne.0 ) then
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,texte(langue,14)) elemen
200 write (ulsort,*) 'triangles',(tritet(letetr,iaux),iaux=1,4)
202 ntesho(elemen) = letetr
203 ntesca(letetr) = elemen
205 call utaste ( letetr,
206 > nbtrto, nbtecf, nbteca,
208 > tritet, cotrte, aretet,
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,90002) "sommets", listso
214 noeele(elemen,1) = nnosca(listso(1))
215 noeele(elemen,2) = nnosca(listso(2))
216 noeele(elemen,3) = nnosca(listso(3))
217 noeele(elemen,4) = nnosca(listso(4))
218 famele(elemen) = cfatet(cofamd,famtet(letetr))
219 typele(elemen) = cfatet(cotyel,famtet(letetr))
226 c 4. Conversion en quadratique
231 c la face fi est opposee au sommet ni
245 c *................*.................*
249 do 41 , letet0 = 1 , nbteto
253 #ifdef _DEBUG_HOMARD_
254 write (ulsort,texte(langue,11)) mess14(langue,2,3), letetr
257 etat = mod( hettet(letetr) , 100 )
259 if ( etat.eq.0 .or. hierar.ne.0 ) then
262 #ifdef _DEBUG_HOMARD_
263 write (ulsort,texte(langue,14)) elemen
264 write (ulsort,*) 'triangles',(tritet(letetr,iaux),iaux=1,3)
266 ntesho(elemen) = letetr
267 ntesca(letetr) = elemen
269 call utaste ( letetr,
270 > nbtrto, nbtecf, nbteca,
272 > tritet, cotrte, aretet,
274 #ifdef _DEBUG_HOMARD_
275 write (ulsort,90002) "sommets", listso
278 noeele(elemen,1) = nnosca(listso(1))
279 noeele(elemen,2) = nnosca(listso(2))
280 noeele(elemen,3) = nnosca(listso(3))
281 noeele(elemen,4) = nnosca(listso(4))
282 noeele(elemen,5) = nnosca(np2are(listar(1)))
283 noeele(elemen,6) = nnosca(np2are(listar(4)))
284 noeele(elemen,7) = nnosca(np2are(listar(2)))
285 noeele(elemen,8) = nnosca(np2are(listar(3)))
286 noeele(elemen,9) = nnosca(np2are(listar(5)))
287 noeele(elemen,10) = nnosca(np2are(listar(6)))
288 cgn write (ulsort,*) (noeele(elemen,iaux),iaux=5,10)
289 famele(elemen) = cfatet(cofamd,famtet(letetr))
290 typele(elemen) = cfatet(cotyel,famtet(letetr))
302 if ( codret.ne.0 ) then
306 write (ulsort,texte(langue,1)) 'Sortie', nompro
307 write (ulsort,texte(langue,2)) codret
311 #ifdef _DEBUG_HOMARD_
312 write (ulsort,texte(langue,1)) 'Sortie', nompro