1 subroutine cmcp4c ( indtri, triint,
3 > areint, areqtr, areqqu, niveau,
4 > aretri, famtri, hettri,
5 > filtri, pertri, nivtri,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c Creation du Maillage - Conformite - decoupage des Pentaedres
31 c Construction des triangles internes
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . indtri . es . 1 . indice du dernier triangle cree .
37 c . triint . s . 7 . triangles internes au pentaedre .
38 c . . . . 1-4 = base parallele au triangle .
39 c . . . . 1 = cote F1, quad suivant quad coupe en 4 .
40 c . . . . 2 = cote F1, quad suivant .
41 c . . . . 3 = cote F2, quad suivant quad coupe en 4 .
42 c . . . . 4 = cote F2, quad suivant .
43 c . . . . 5-6 = base coupant le triangle .
44 c . . . . 5 = cote F1 .
45 c . . . . 6 = cote F2 .
46 c . . . . 7 = s'appuyant sur la derniere non coupee .
47 c . lesare . e . 1 . liste des aretes du pentaedre utiles .
48 c . . . . 1 = arete de quadrangle non decoupee .
49 c . areint . e . 2 . aretes internes au pentaedre .
50 c . areqtr . s .(4,0:2) . aretes tri tracees sur les faces decoupees .
51 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
52 c . areqqu . s . 4 . aretes qua tracees sur les faces decoupees .
53 c . hettri . es . nouvtr . historique de l'etat des triangles .
54 c . filtri . es . nouvtr . premier fils des triangles .
55 c . pertri . es . nouvtr . pere des triangles .
56 c . nivtri . es . nouvtr . niveau des triangles .
57 c . famtri . es . nouvtr . famille des triangles .
58 c . niveau . e . 1 . niveau a attribuer aux triangles .
59 c . ulsort . e . 1 . unite logique de la sortie generale .
60 c . langue . e . 1 . langue des messages .
61 c . . . . 1 : francais, 2 : anglais .
62 c . codret . es . 1 . code de retour des modules .
63 c . . . . 0 : pas de probleme .
64 c . . . . 1 : aucune arete ne correspond .
65 c ______________________________________________________________________
68 c 0. declarations et dimensionnement
71 c 0.1. ==> generalites
77 parameter ( nompro = 'CMCP4C' )
96 integer aretri(nouvtr,3), famtri(nouvtr)
97 integer hettri(nouvtr), filtri(nouvtr), pertri(nouvtr)
98 integer nivtri(nouvtr)
100 integer ulsort, langue, codret
102 c 0.4. ==> variables locales
108 parameter ( nbmess = 10 )
109 character*80 texte(nblang,nbmess)
111 c 0.5. ==> initialisations
112 c ______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
132 c 2. Les triangles paralleles aux faces triangulaires
137 #ifdef _DEBUG_HOMARD_
138 write (ulsort,texte(langue,3)) 'CMCTRI_1', nompro
140 call cmctri ( aretri, famtri, hettri,
141 > filtri, pertri, nivtri,
142 > indtri, areqtr(1,1), areqqu(4), areint(1),
147 #ifdef _DEBUG_HOMARD_
148 write (ulsort,texte(langue,3)) 'CMCTRI_2', nompro
150 call cmctri ( aretri, famtri, hettri,
151 > filtri, pertri, nivtri,
152 > indtri, areqtr(2,1), areint(1), areqqu(2),
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,texte(langue,3)) 'CMCTRI_3', nompro
160 call cmctri ( aretri, famtri, hettri,
161 > filtri, pertri, nivtri,
162 > indtri, areqtr(1,2), areint(2), areqqu(4),
167 #ifdef _DEBUG_HOMARD_
168 write (ulsort,texte(langue,3)) 'CMCTRI_4', nompro
170 call cmctri ( aretri, famtri, hettri,
171 > filtri, pertri, nivtri,
172 > indtri, areqtr(2,2), areqqu(2), areint(2),
176 c 3. Les triangles coupant les faces triangulaires
181 #ifdef _DEBUG_HOMARD_
182 write (ulsort,texte(langue,3)) 'CMCTRI_5', nompro
184 call cmctri ( aretri, famtri, hettri,
185 > filtri, pertri, nivtri,
186 > indtri, areqtr(3,2), areint(1), areqqu(1),
191 #ifdef _DEBUG_HOMARD_
192 write (ulsort,texte(langue,3)) 'CMCTRI_6', nompro
194 call cmctri ( aretri, famtri, hettri,
195 > filtri, pertri, nivtri,
196 > indtri, areqtr(4,2), areint(2), areqqu(3),
200 c 4. Le triangle sur l'arete non decoupee
205 #ifdef _DEBUG_HOMARD_
206 write (ulsort,texte(langue,3)) 'CMCTRI_7', nompro
208 call cmctri ( aretri, famtri, hettri,
209 > filtri, pertri, nivtri,
210 > indtri, areint(1), lesare(1), areint(2),
217 if ( codret.ne.0 ) then
221 write (ulsort,texte(langue,1)) 'Sortie', nompro
222 write (ulsort,texte(langue,2)) codret
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,1)) 'Sortie', nompro