1 subroutine cmcp4e ( 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 ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . indtet . es . 1 . indice du dernier tetraedre cree .
38 c . indptp . e . 1 . indice du dernier pere enregistre .
39 c . lepent . e . 1 . pentaedre a decouper .
40 c . trifad . e .(4,0:2) . triangles traces sur les faces decoupees .
41 c . cotrvo . e .(4,0:2) . code des triangles dans les volumes .
42 c . triint . e . 7 . triangles internes au pentaedre .
43 c . . . . 1-4 = base parallele au triangle .
44 c . . . . 1 = cote F1, quad suivant quad coupe en 4 .
45 c . . . . 2 = cote F1, quad suivant .
46 c . . . . 3 = cote F2, quad suivant quad coupe en 4 .
47 c . . . . 4 = cote F2, quad suivant .
48 c . . . . 5-6 = base coupant le triangle .
49 c . . . . 5 = cote F1 .
50 c . . . . 6 = cote F2 .
51 c . . . . 7 = s'appuyant sur la derniere non 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 = 'CMCP4E' )
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 face suivante
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(1,0), triint(7), triint(1), triint(3),
153 > cotrvo(1,0), 2, 3, 5,
154 > nupere, nufami, indtet )
156 c 2.2. ==> 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(2,0), triint(7), triint(4), triint(2),
165 > cotrvo(2,0), 4, 3, 5,
166 > nupere, nufami, indtet )
172 if ( codret.ne.0 ) then
176 write (ulsort,texte(langue,1)) 'Sortie', nompro
177 write (ulsort,texte(langue,2)) codret
181 #ifdef _DEBUG_HOMARD_
182 write (ulsort,texte(langue,1)) 'Sortie', nompro