1 subroutine cmcp3e ( indtet, indptp,
3 > trifad, cotrvo, triint,
4 > hettet, tritet, cotrte,
5 > filtet, pertet, famtet,
7 > 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 Creation du Maillage - Conformite - decoupage des Pentaedres
32 c Construction des tetraedres
33 c Remarque : cmcp3e et cmcp3h sont des clones
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:2) . triangles traces sur les faces decoupees .
42 c . cotrvo . e .(4,0:2) . code des triangles dans les volumes .
43 c . triint . e . 17 . triangles internes au pentaedre .
44 c . . . . 1-4 = bordant la pyramide .
45 c . . . . 5 = bordant la face f1 .
46 c . . . . 6 = bordant la face f2 .
47 c . . . . 7 = s'appuyant sur la derniere non coupee .
48 c . . . . 8-11 = appuyes sur les filles des aretes .
50 c . . . . 12-17 = appuyes sur une arete interne a .
51 c . . . . une face coupee .
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 = 'CMCP3E' )
101 integer indtet, indptp
103 integer trifad(4,0:2), cotrvo(4,0:2)
105 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
106 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
107 integer fampen(nouvpe), cfapen(nctfpe,nbfpen)
109 integer ulsort, langue, codret
111 c 0.4. ==> variables locales
114 integer nupere, nufami
117 parameter ( nbmess = 10 )
118 character*80 texte(nblang,nbmess)
120 c 0.5. ==> initialisations
121 c ______________________________________________________________________
129 #ifdef _DEBUG_HOMARD_
130 write (ulsort,texte(langue,1)) 'Entree', nompro
136 c 1.2. ==> Le pere des tetraedres et leur famille
139 nufami = cfapen(coftfp,fampen(lepent))
144 c 2.1. ==> tetraedre du cote de la pyramide
147 #ifdef _DEBUG_HOMARD_
148 write (ulsort,texte(langue,3)) 'CMCTET_1', nompro
150 call cmctet ( tritet, cotrte, famtet,
151 > hettet, filtet, pertet,
152 > trifad(3,0), triint(1), triint(8), triint(16),
153 > cotrvo(3,0), 4, 4, 2,
154 > nupere, nufami, indtet )
156 c 2.1. ==> tetraedre de l'autre cote
159 #ifdef _DEBUG_HOMARD_
160 write (ulsort,texte(langue,3)) 'CMCTET_2', nompro
162 call cmctet ( tritet, cotrte, famtet,
163 > hettet, filtet, pertet,
164 > trifad(3,1), triint(5), triint(16), triint(9),
165 > cotrvo(3,1), 2, 2, 2,
166 > nupere, nufami, indtet )
171 c 3.1. ==> tetraedre du cote de la pyramide
174 #ifdef _DEBUG_HOMARD_
175 write (ulsort,texte(langue,3)) 'CMCTET_3', nompro
177 call cmctet ( tritet, cotrte, famtet,
178 > hettet, filtet, pertet,
179 > trifad(4,0), triint(3), triint(10), triint(17),
180 > cotrvo(4,0), 4, 4, 2,
181 > nupere, nufami, indtet )
183 c 3.1. ==> tetraedre de l'autre cote
186 #ifdef _DEBUG_HOMARD_
187 write (ulsort,texte(langue,3)) 'CMCTET_4', nompro
189 call cmctet ( tritet, cotrte, famtet,
190 > hettet, filtet, pertet,
191 > trifad(4,1), triint(6), triint(17), triint(11),
192 > cotrvo(4,1), 2, 2, 2,
193 > nupere, nufami, indtet )
196 c 4. Face quadrangulaire dont l'arete coupee est sur la face 1
198 c 4.1. ==> tetraedre central
201 #ifdef _DEBUG_HOMARD_
202 write (ulsort,texte(langue,3)) 'CMCTET_5', nompro
204 call cmctet ( tritet, cotrte, famtet,
205 > hettet, filtet, pertet,
206 > trifad(1,0), triint(6), triint(13), triint(12),
207 > cotrvo(1,0), 4, 4, 2,
208 > nupere, nufami, indtet )
210 c 4.2. ==> tetraedre du cote pyramide
213 #ifdef _DEBUG_HOMARD_
214 write (ulsort,texte(langue,3)) 'CMCTET_6', nompro
216 call cmctet ( tritet, cotrte, famtet,
217 > hettet, filtet, pertet,
218 > trifad(1,1), triint(4), triint(12), triint(8),
219 > cotrvo(1,1), 4, 2, 4,
220 > nupere, nufami, indtet )
222 c 4.3. ==> tetraedre de l'autre cote
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,3)) 'CMCTET_7', nompro
228 call cmctet ( tritet, cotrte, famtet,
229 > hettet, filtet, pertet,
230 > trifad(1,2), triint(7), triint(9), triint(13),
231 > cotrvo(1,2), 2, 2, 4,
232 > nupere, nufami, indtet )
235 c 5. Face quadrangulaire dont l'arete coupee est sur la face 2
237 c 5.1. ==> tetraedre central
240 #ifdef _DEBUG_HOMARD_
241 write (ulsort,texte(langue,3)) 'CMCTET_8', nompro
243 call cmctet ( tritet, cotrte, famtet,
244 > hettet, filtet, pertet,
245 > trifad(2,0), triint(5), triint(15), triint(14),
246 > cotrvo(2,0), 4, 4, 2,
247 > nupere, nufami, indtet )
249 c 5.2. ==> tetraedre du cote pyramide
252 #ifdef _DEBUG_HOMARD_
253 write (ulsort,texte(langue,3)) 'CMCTET_9', nompro
255 call cmctet ( tritet, cotrte, famtet,
256 > hettet, filtet, pertet,
257 > trifad(2,1), triint(2), triint(14), triint(10),
258 > cotrvo(2,1), 4, 2, 4,
259 > nupere, nufami, indtet )
261 c 5.3. ==> tetraedre de l'autre cote
264 #ifdef _DEBUG_HOMARD_
265 write (ulsort,texte(langue,3)) 'CMCTET_10', nompro
267 call cmctet ( tritet, cotrte, famtet,
268 > hettet, filtet, pertet,
269 > trifad(2,2), triint(7), triint(11), triint(15),
270 > cotrvo(2,2), 4, 2, 4,
271 > nupere, nufami, indtet )
277 if ( codret.ne.0 ) then
281 write (ulsort,texte(langue,1)) 'Sortie', nompro
282 write (ulsort,texte(langue,2)) codret
286 #ifdef _DEBUG_HOMARD_
287 write (ulsort,texte(langue,1)) 'Sortie', nompro