1 subroutine pcceq1 ( cfanoe, famnoe, nnosho,
2 > cfampo, fammpo, nmpsho,
3 > cfaare, famare, narsho,
4 > cfatri, famtri, ntrsho,
5 > cfaqua, famqua, nqusho,
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 aPres adaptation - Conversion - Creation des EQuivalences - phase 1
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . cfanoe . e . nctfno*. codes des familles des noeuds .
35 c . . . nbnoto . 1 : famille MED .
36 c . . . . + l : appartenance a l'equivalence l .
37 c . famnoe . e . nbnoto . famille des aretes .
38 c . nnosho . e . rsnoto . numero des noeuds dans HOMARD .
39 c . cfampo . e . nctfmp*. codes des familles des mailles-points .
40 c . . . nbfmpo . 1 : famille MED .
41 c . . . . 2 : type de maille-point .
42 c . . . . 3 : famille des sommets .
43 c . . . . + l : appartenance a l'equivalence l .
44 c . fammpo . e . nbmpto . famille des mailles-points .
45 c . nmpsho . e . rsmpac . numero des mailles-points dans HOMARD .
46 c . cfaare . e . nctfar*. codes des familles des aretes .
47 c . . . nbfare . 1 : famille MED .
48 c . . . . 2 : type de segment .
49 c . . . . 3 : orientation .
50 c . . . . 4 : famille d'orientation inverse .
51 c . . . . 5 : numero de ligne de frontiere .
52 c . . . . > 0 si concernee par le suivi de frontiere.
53 c . . . . <= 0 si non concernee .
54 c . . . . 6 : famille frontiere active/inactive .
55 c . . . . 7 : numero de surface de frontiere .
56 c . . . . + l : appartenance a l'equivalence l .
57 c . famare . e . nbarto . famille des aretes .
58 c . narsho . e . rsarac . numero des aretes dans HOMARD .
59 c . cfatri . e . nctftr*. codes des familles des triangles .
60 c . . . nbftri . 1 : famille MED .
61 c . . . . 2 : type de triangle .
62 c . . . . 3 : numero de surface de frontiere .
63 c . . . . 4 : famille des aretes internes apres raf.
64 c . . . . + l : appartenance a l'equivalence l .
65 c . famtri . e . nbtrto . famille des triangles .
66 c . ntrsho . e . rstrac . numero des triangles dans HOMARD .
67 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
68 c . . . nbfqua . 1 : famille MED .
69 c . . . . 2 : type de quadrangle .
70 c . . . . 3 : numero de surface de frontiere .
71 c . . . . 4 : famille des aretes internes apres raf.
72 c . . . . 5 : famille des triangles de conformite .
73 c . . . . 6 : famille de sf active/inactive .
74 c . . . . + l : appartenance a l'equivalence l .
75 c . famqua . . nbquto . famille des quadrangles .
76 c . nqusho . e . rsquac . numero des quadrangles dans HOMARD .
77 c . typele . e . nbelem . type des elements .
78 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
79 c . langue . e . 1 . langue des messages .
80 c . . . . 1 : francais, 2 : anglais .
81 c . codret . es . 1 . code de retour des modules .
82 c . . . . 0 : pas de probleme .
83 c . . . . 1 : probleme .
84 c ______________________________________________________________________
87 c 0. declarations et dimensionnement
90 c 0.1. ==> generalites
96 parameter ( nompro = 'PCCEQ1' )
117 integer nnosho(rsnoto), nmpsho(rsmpac), narsho(rsarac)
118 integer ntrsho(rstrac), nqusho(rsteac)
119 integer typele(nbelem)
121 integer cfanoe(nctfno,nbfnoe), famnoe(nbnoto)
122 integer cfampo(nctfmp,nbfmpo), fammpo(nbmpto)
123 integer cfaare(nctfar,nbfare), famare(nbarto)
124 integer cfatri(nctftr,nbftri), famtri(nbtrto)
125 integer cfaqua(nctfqu,nbfqua), famqua(nbquto)
127 integer ulsort, langue, codret
129 c 0.4. ==> variables locales
134 parameter ( nbmess = 10 )
135 character*80 texte(nblang,nbmess)
137 c 0.5. ==> initialisations
138 c ______________________________________________________________________
146 #ifdef _DEBUG_HOMARD_
147 write (ulsort,texte(langue,1)) 'Entree', nompro
151 texte(1,10) = '(/,''Decompte des equivalences - Phase 1 :'')'
153 texte(2,10) = '(/,''Description of equivalences - Phase # 1 :'')'
155 #ifdef _DEBUG_HOMARD_
156 write (ulsort,texte(langue,10))
162 c 2. on compte combien d'entites appartiennent a des equivalences.
165 c 2.1. ==> les noeuds
167 if ( codret.eq.0 ) then
171 #ifdef _DEBUG_HOMARD_
172 write (ulsort,texte(langue,3)) 'PCCEQ2_no', nompro
175 > nbnoto, nctfno, nbfnoe,
176 > ncefno, nbeqno, jaux, jaux, rsnoto,
177 > cfanoe, famnoe, nnosho,
179 > ulsort, langue, codret )
183 c 2.2. ==> les mailles-points
185 if ( codret.eq.0 ) then
189 #ifdef _DEBUG_HOMARD_
190 write (ulsort,texte(langue,3)) 'PCCEQ2_mp', nompro
193 > nbmpto, nctfmp, nbfmpo,
194 > ncefmp, nbeqmp, tyhmpo, tyhmpo, nbelem,
195 > cfampo, fammpo, nmpsho,
197 > ulsort, langue, codret )
201 c 2.3. ==> les aretes
203 if ( codret.eq.0 ) then
207 #ifdef _DEBUG_HOMARD_
208 write (ulsort,texte(langue,3)) 'PCCEQ2_ar', nompro
211 > nbarto, nctfar, nbfare,
212 > ncefar, nbeqar, tyhse1, tyhse2, nbelem,
213 > cfaare, famare, narsho,
215 > ulsort, langue, codret )
219 c 2.4. ==> les triangles
221 if ( codret.eq.0 ) then
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,3)) 'PCCEQ2_tr', nompro
229 > nbtrto, nctftr, nbftri,
230 > nceftr, nbeqtr, tyhtr1, tyhtr2, nbelem,
231 > cfatri, famtri, ntrsho,
233 > ulsort, langue, codret )
237 c 2.5. ==> les quadrangles
239 if ( codret.eq.0 ) then
243 #ifdef _DEBUG_HOMARD_
244 write (ulsort,texte(langue,3)) 'PCCEQ2_qu', nompro
247 > nbquto, nctfqu, nbfqua,
248 > ncefqu, nbeqqu, tyhqu1, tyhqu2, nbelem,
249 > cfaqua, famqua, nqusho,
251 > ulsort, langue, codret )
259 if ( codret.ne.0 ) then
263 write (ulsort,texte(langue,1)) 'Sortie', nompro
264 write (ulsort,texte(langue,2)) codret
268 #ifdef _DEBUG_HOMARD_
269 write (ulsort,texte(langue,1)) 'Sortie', nompro