1 subroutine cmcp1e ( indtet, indptp,
3 > trifad, cotrvo, triint,
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 .(2,0:2) . triangles traces sur les faces decoupees .
42 c . cotrvo . e .(2,0:2) . code des triangles dans les volumes .
43 c . triint . e . 2 .triangles internes au pentaedre .
44 c . . . . 1 = bordant la face f1 .
45 c . . . . 2 = bordant la face f2 .
46 c . laface . e . 2 . numero des faces non coupees .
47 c . coface . e . 2 . futur code des faces dans le tetraedre .
48 c . hettet . es . nouvte . historique de l'etat des tetraedres .
49 c . tritet . es .nouvtf*4. numeros des 4 triangles des tetraedres .
50 c . cotrte . es .nouvtf*4. code des 4 triangles des tetraedres .
51 c . filtet . es . nouvte . premier fils des tetraedres .
52 c . pertet . es . nouvte . pere des tetraedres .
53 c . . . . si pertet(i) > 0 : numero du tetraedre .
54 c . . . . si pertet(i) < 0 : -numero dans pthepe .
55 c . famtet . es . nouvte . famille des tetraedres .
56 c . fampen . e . nouvpe . famille des pentaedres .
57 c . cfapen . e . nctfpe*. codes des familles des pentaedres .
58 c . . . nbfpen . 1 : famille MED .
59 c . . . . 2 : type de pentaedres .
60 c . . . . 3 : famille des tetraedres de conformite .
61 c . . . . 4 : famille des pyramides de conformite .
62 c . . . . 3 : famille des tetraedres de conformite .
63 c . . . . 4 : famille des pyramides de conformite .
64 c . ulsort . e . 1 . unite logique de la sortie generale .
65 c . langue . e . 1 . langue des messages .
66 c . . . . 1 : francais, 2 : anglais .
67 c . codret . es . 1 . code de retour des modules .
68 c . . . . 0 : pas de probleme .
69 c . . . . 1 : aucune arete ne correspond .
70 c ______________________________________________________________________
73 c 0. declarations et dimensionnement
76 c 0.1. ==> generalites
82 parameter ( nompro = 'CMCP1E' )
97 integer indtet, indptp
99 integer trifad(2,0:2), cotrvo(2,0:2)
101 integer laface(2), coface(2)
102 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
103 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
104 integer fampen(nouvpe), cfapen(nctfpe,nbfpen)
106 integer ulsort, langue, codret
108 c 0.4. ==> variables locales
111 integer nupere, nufami
114 parameter ( nbmess = 10 )
115 character*80 texte(nblang,nbmess)
117 c 0.5. ==> initialisations
118 c ______________________________________________________________________
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,1)) 'Entree', nompro
133 c 1.2. ==> Le pere des tetraedres et leur famille
136 nufami = cfapen(coftfp,fampen(lepent))
143 #ifdef _DEBUG_HOMARD_
144 write (ulsort,texte(langue,3)) 'CMCTET_1', nompro
146 call cmctet ( tritet, cotrte, famtet,
147 > hettet, filtet, pertet,
148 > laface(1), triint(1), trifad(2,1), trifad(1,1),
149 > coface(1), 6, cotrvo(2,1), cotrvo(1,1),
150 > nupere, nufami, indtet )
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,texte(langue,3)) 'CMCTET_2', nompro
160 call cmctet ( tritet, cotrte, famtet,
161 > hettet, filtet, pertet,
162 > laface(2), triint(2), trifad(1,2), trifad(2,2),
163 > coface(2), 6, cotrvo(1,2), cotrvo(2,2),
164 > nupere, nufami, indtet )
170 if ( codret.ne.0 ) then
174 write (ulsort,texte(langue,1)) 'Sortie', nompro
175 write (ulsort,texte(langue,2)) codret
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,texte(langue,1)) 'Sortie', nompro