1 subroutine cmcp5e ( indtet, indptp,
3 > trifad, cotrvo, triint,
4 > facdec, laface, coface,
5 > hettet, tritet, cotrte,
6 > filtet, pertet, famtet,
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 Creation du Maillage - Conformite - decoupage des Pentaedres
33 c Construction des tetraedres
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . indtet . es . 1 . indice du dernier tetraedre cree .
39 c . indptp . e . 1 . indice du dernier pere enregistre .
40 c . lepent . e . 1 . pentaedre a decouper .
41 c . trifad . e .(4,0:3) . triangles traces sur les faces decoupees .
42 c . cotrvo . e .(4,0:3) . code des triangles dans les volumes .
43 c . triint . e . 15 . triangles internes au pentaedre .
44 c . . . . 1-3 = milieu/milieu et sommet face opposee.
45 c . . . . 4-6 = milieu/milieu et noeud central .
46 c . . . . 7-9 = arete face oppose et noeud central .
47 c . . . . 10-15 = appuyes sur une arete interne a .
48 c . . . . une face quadrangulaire coupee .
49 c . facdec . e . 1 . numero local de la face non coupee .
50 c . laface . e . 1 . numero global de la face non coupee .
51 c . coface . e . 1 . futur code de la face dans le tetraedre .
52 c . hettet . es . nouvte . historique de l'etat des tetraedres .
53 c . tritet . es .nouvtf*4. numeros des 4 triangles des tetraedres .
54 c . cotrte . es .nouvtf*4. code des 4 triangles des tetraedres .
55 c . filtet . es . nouvte . premier fils des tetraedres .
56 c . pertet . es . nouvte . pere des tetraedres .
57 c . . . . si pertet(i) > 0 : numero du tetraedre .
58 c . . . . si pertet(i) < 0 : -numero dans pthepe .
59 c . famtet . es . nouvte . famille des tetraedres .
60 c . fampen . e . nouvpe . famille des pentaedres .
61 c . cfapen . e . nctfpe*. codes des familles des pentaedres .
62 c . . . nbfpen . 1 : famille MED .
63 c . . . . 2 : type de pentaedres .
64 c . . . . 3 : famille des tetraedres de conformite .
65 c . . . . 4 : famille des pyramides de conformite .
66 c . . . . 3 : famille des tetraedres de conformite .
67 c . . . . 4 : famille des pyramides de conformite .
68 c . ulsort . e . 1 . unite logique de la sortie generale .
69 c . langue . e . 1 . langue des messages .
70 c . . . . 1 : francais, 2 : anglais .
71 c . codret . es . 1 . code de retour des modules .
72 c . . . . 0 : pas de probleme .
73 c . . . . 1 : aucune arete ne correspond .
74 c ______________________________________________________________________
77 c 0. declarations et dimensionnement
80 c 0.1. ==> generalites
86 parameter ( nompro = 'CMCP5E' )
102 integer indtet, indptp
104 integer trifad(4,0:3), cotrvo(4,0:3)
106 integer facdec, laface, coface
107 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
108 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
109 integer fampen(nouvpe), cfapen(nctfpe,nbfpen)
111 integer ulsort, langue, codret
113 c 0.4. ==> variables locales
116 integer nupere, nufami
119 parameter ( nbmess = 10 )
120 character*80 texte(nblang,nbmess)
122 c 0.5. ==> initialisations
123 c ______________________________________________________________________
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,1)) 'Entree', nompro
138 c 1.2. ==> Le pere des tetraedres et leur famille
141 nufami = cfapen(coftfp,fampen(lepent))
142 cgn write (ulsort,*) 'lepent', lepent
143 cgn write (ulsort,*) 'fampen(lepent)', fampen(lepent)
144 cgn write (ulsort,*) 'nufami', nufami
147 c 2. Tetraedres sur les triangles de la face coupee, sauf le central
152 jaux = per1a3(1,iaux)
155 #ifdef _DEBUG_HOMARD_
156 write (ulsort,texte(langue,3)) 'CMCTET_123', nompro
158 call cmctet ( tritet, cotrte, famtet,
159 > hettet, filtet, pertet,
160 > triint(iaux), trifad(4,iaux), trifad(jaux,2), trifad(iaux,1),
161 > 4, cotrvo(4,iaux), cotrvo(jaux,2), cotrvo(iaux,1),
162 > nupere, nufami, indtet )
167 c 3. Tetraedres avec une arete de la face coupee, le sommet oppose,
173 jaux = per1a3(1,iaux)
176 #ifdef _DEBUG_HOMARD_
177 write (ulsort,texte(langue,3)) 'CMCTET_456', nompro
179 call cmctet ( tritet, cotrte, famtet,
180 > hettet, filtet, pertet,
181 > triint(iaux), triint(iaux+3), triint(iaux+9), triint(jaux+12),
183 > nupere, nufami, indtet )
188 c 4. Tetraedres bases sur le triangle central aux faces quadrangulaires
194 #ifdef _DEBUG_HOMARD_
195 write (ulsort,texte(langue,3)) 'CMCTET_789', nompro
197 call cmctet ( tritet, cotrte, famtet,
198 > hettet, filtet, pertet,
199 > trifad(iaux,0), triint(iaux+6), triint(iaux+9), triint(iaux+12),
200 > cotrvo(iaux,0), 2, 2, 4,
201 > nupere, nufami, indtet )
206 c 5. Tetraedre sur le triangle central de la face coupee
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,texte(langue,3)) 'CMCTET_10', nompro
213 call cmctet ( tritet, cotrte, famtet,
214 > hettet, filtet, pertet,
215 > trifad(4,0), triint(5), triint(6), triint(4),
216 > cotrvo(4,0), 4, 2, 4,
217 > nupere, nufami, indtet )
220 c 8. Tetraedre sur la face non coupee
224 if ( facdec.eq.1 ) then
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,3)) 'CMCTET_11', nompro
229 call cmctet ( tritet, cotrte, famtet,
230 > hettet, filtet, pertet,
231 > laface, triint(7), triint(9), triint(8),
233 > nupere, nufami, indtet )
237 #ifdef _DEBUG_HOMARD_
238 write (ulsort,texte(langue,3)) 'CMCTET_11', nompro
240 call cmctet ( tritet, cotrte, famtet,
241 > hettet, filtet, pertet,
242 > laface, triint(8), triint(7), triint(9),
244 > nupere, nufami, indtet )
252 if ( codret.ne.0 ) then
256 write (ulsort,texte(langue,1)) 'Sortie', nompro
257 write (ulsort,texte(langue,2)) codret
261 #ifdef _DEBUG_HOMARD_
262 write (ulsort,texte(langue,1)) 'Sortie', nompro