1 subroutine esece2 ( typenh, nbencf, nbenca, nbrfma,
2 > somare, codeen, infosu, codear,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c Entree-Sortie : ECriture d'une Entite - 2
27 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . typenh . e . 1 . code des entites .
31 c . . . . -1 : noeuds .
32 c . . . . 0 : mailles-points .
33 c . . . . 1 : aretes .
34 c . . . . 2 : triangles .
35 c . . . . 3 : tetraedres .
36 c . . . . 4 : quadrangles .
37 c . . . . 5 : pyramides .
38 c . . . . 6 : hexaedres .
39 c . . . . 7 : pentaedres .
40 c . nbencf . e . 1 . nombre d'entites decrites par faces .
41 c . nbenca . e . 1 . nombre d'entites decrites par aretes .
42 c . nbrfma . e . 1 . nbre faces par maille .
43 c . somare . e .2*nbarto. numeros des extremites d'arete .
44 c . codeen . e .nbencf**. connectivite descendante des mailles .
45 c . infosu . e .nbencf**. code des faces dans les mailles 3D .
46 c . codear . e .nbenca**. connectivite des mailles par aretes .
47 c . tbiaux . s . * . tableau tampon entier .
48 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
49 c . langue . e . 1 . langue des messages .
50 c . . . . 1 : francais, 2 : anglais .
51 c . codret . es . 1 . code de retour des modules .
52 c . . . . 0 : pas de probleme .
53 c ______________________________________________________________________
56 c 0. declarations et dimensionnement
59 c 0.1. ==> generalites
65 parameter ( nompro = 'ESECE2' )
84 integer nbencf, nbenca, nbrfma
86 integer codeen(nbencf,*), infosu(nbencf,*), codear(nbenca,*)
89 integer ulsort, langue, codret
91 c 0.4. ==> variables locales
95 integer iaux, jaux, kaux, laux
100 parameter ( nbmess = 100 )
101 character*80 texte(nblang,nbmess)
102 c ______________________________________________________________________
110 #ifdef _DEBUG_HOMARD_
111 write (ulsort,texte(langue,1)) 'Entree', nompro
115 texte(1,4) = '(''... Conversion des '',i10,1x,a)'
117 texte(2,4) = '(''... Conversion of '',i10,1x,a)'
121 #ifdef _DEBUG_HOMARD_
122 write (ulsort,texte(langue,4)) nbencf, mess14(langue,3,typenh)
123 write (ulsort,90002) 'nbencf', nbencf
124 write (ulsort,90002) 'nbenca', nbenca
128 c 2. Mise en place de la connectivite descendante
131 if ( codret.eq.0 ) then
137 if ( typenh.eq.2 ) then
139 do 221 , iaux = 1, nbencf
140 do 2211, jaux = 1, nbrfma
141 aret(jaux) = codeen(iaux,jaux)
143 cgn write(ulsort,*)aret
144 call utorat ( somare, aret(1), aret(2), aret(3),
145 > orient(1), orient(2), orient(3) )
146 cgn write(ulsort,*)(orient(jaux),jaux = 1, nbrfma)
147 do 2212, jaux = 1, nbrfma
149 tbiaux(kaux) = orient(jaux)*aret(jaux)
153 c 2.3. ==> Tetraedres
155 elseif ( typenh.eq.3 ) then
157 cgn write(ulsort,*) typenh
158 do 231 , iaux = 1, nbencf
159 do 2311, jaux = 1, nbrfma
160 laux = nofmed(typenh,jaux,1)
161 cgn write(ulsort,*) jaux,laux
162 orient(jaux) = orcott(laux,infosu(iaux,laux))
163 cgn write(ulsort,*) laux, codeen(iaux,laux), orient(jaux)
165 tbiaux(kaux) = orient(jaux)*codeen(iaux,laux)
169 c 2.4. ==> Quadrangles
171 elseif ( typenh.eq.4 ) then
173 do 241 , iaux = 1, nbencf
174 do 2411, jaux = 1, nbrfma
175 aret(jaux) = codeen(iaux,jaux)
177 cgn write(ulsort,*)aret
178 call utoraq ( somare, aret(1), aret(2), aret(3), aret(4),
179 > orient(1), orient(2), orient(3), orient(4) )
180 cgn write(ulsort,*)(orient(jaux),jaux = 1, nbrfma)
181 do 2412, jaux = 1, nbrfma
183 tbiaux(kaux) = orient(jaux)*aret(jaux)
189 elseif ( typenh.eq.5 ) then
191 do 251 , iaux = 1, nbencf
192 do 2511, jaux = 1, nbrfma
193 laux = nofmed(typenh,jaux,1)
194 orient(jaux) = orcofy(laux,infosu(iaux,laux))
195 cgn write(ulsort,*) laux, codeen(iaux,laux), orient(jaux)
197 tbiaux(kaux) = orient(jaux)*codeen(iaux,laux)
203 elseif ( typenh.eq.6 ) then
205 do 261 , iaux = 1, nbencf
206 do 2611, jaux = 1, nbrfma
207 laux = nofmed(typenh,jaux,1)
208 orient(jaux) = orcoqh(laux,infosu(iaux,laux))
209 cgn write(ulsort,*) laux, codeen(iaux,laux), orient(jaux)
211 tbiaux(kaux) = orient(jaux)*codeen(iaux,laux)
215 c 2.7. ==> Pentaedres
217 elseif ( typenh.eq.7 ) then
219 do 271 , iaux = 1, nbencf
220 do 2711, jaux = 1, nbrfma
221 laux = nofmed(typenh,jaux,1)
222 orient(jaux) = orcofp(laux,infosu(iaux,laux))
223 cgn write(ulsort,*) laux, codeen(iaux,laux), orient(jaux)
225 tbiaux(kaux) = orient(jaux)*codeen(iaux,laux)
241 c 3. Quand il peut y avoir une description par arete, on complete
242 c le tableau avec les premieres valeurs de la connectivite
243 c pour optimiser le remplissage et utiliser le dimensionnement
244 c habituel des entites, nbento
245 c Une entite a nbrfac faces et nbrare aretes.
246 c La connectivite descendante ecrite dans le fichier med
247 c est dimensionnee a nbento*nbrfac.
248 c Dans esece2, on remplit donc le tableau avec deux parties :
249 c . La connectivite descendante proprement dite, soit
250 c nbencf*nbrfac variables.
251 c . La connectivite par aretes des nbenca entites decrites, en
252 c se limitant aux nbrfac premieres, soit nbenca*nbrfac
254 c Cela fait bien en tout nbento*nbrfac = (nbencf+nbenca)*nbrfac
255 c On ecrit dans esecs5 la fin des descriptions par aretes,
256 c donc au dela de la nbrfac-ieme.
257 c Exemple : les pyramides sont decrites par 5 faces ou 8 aretes.
258 c Pour toutes celles decrites par aretes, on met ici les numeros
259 c de leurs 5 premieres aretes. Les autres seront geres avec les
260 c profils dans esecs5
261 c La lecture est faite dans eslee1.
264 if ( nbenca.gt.0 ) then
266 if ( codret.eq.0 ) then
268 do 31 , iaux = 1, nbenca
270 do 311, jaux = 1, nbrfma
272 tbiaux(kaux) = codear(iaux,jaux)
285 if ( codret.ne.0 ) then
289 write (ulsort,texte(langue,1)) 'Sortie', nompro
290 write (ulsort,texte(langue,2)) codret
294 #ifdef _DEBUG_HOMARD_
295 write (ulsort,texte(langue,1)) 'Sortie', nompro