1 subroutine pcmape ( elemen, nbele0,
4 > facpen, cofape, arepen,
5 > hetpen, fampen, cfapen,
6 > nnosca, npesca, npesho,
7 > famele, noeele, typele,
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
23 c Coperight EDF 1997, 1998, 1999, 2002
24 c ______________________________________________________________________
27 c aPres adaptation - Conversion - MAillage connectivite - PEntaedres
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . elemen . es . 1 . numero du dernier element cree .
34 c . nbele0 . e . 1 . estimation du nombre d'elements .
35 c . somare . e .2*nbarto. numeros des extremites d'arete .
36 c . np2are . e . nbarto . numero du noeud p2 milieu d'arete .
37 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
38 c . facpen . e .nbpecf*5. numeros des faces des pentaedres .
39 c . cofape . e .nbpecf*5. codes des faces des pentaedres .
40 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
41 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
42 c . fampen . e . nbpeto . famille des pentaedres .
43 c . cfapen . . nctfhe. codes des familles des pentaedres .
44 c . . . nbfpen . 1 : famille MED .
45 c . . . . 2 : type d'pentaedres .
46 c . nnosca . e . rsnoto . numero des noeuds du code de calcul .
47 c . npesca . s . rspeto . numero des pentaedres dans le calcul .
48 c . npesho . s . nbele0 . numero des pentaedres dans HOMARD .
49 c . famele . es . nbele0 . famille med des elements .
50 c . noeele . es . nbele0 . noeuds des elements .
52 c . typele . es . nbele0 . type des elements .
53 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
54 c . langue . e . 1 . langue des messages .
55 c . . . . 1 : francais, 2 : anglais .
56 c . codret . es . 1 . code de retour des modules .
57 c . . . . 0 : pas de probleme .
58 c . . . . 1 : probleme .
59 c ______________________________________________________________________
62 c 0. declarations et dimensionnement
65 c 0.1. ==> generalites
71 parameter ( nompro = 'PCMAPE' )
97 integer somare(2,nbarto), np2are(nbarto)
98 integer arequa(nbquto,4)
99 integer facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
100 integer hetpen(nbpeto)
102 integer cfapen(nctfpe,nbfpen), fampen(nbpeto)
104 integer nnosca(rsnoto)
105 integer npesca(rspeto), npesho(nbele0)
107 integer famele(nbele0), noeele(nbele0,nbmane)
108 integer typele(nbele0)
110 integer ulsort, langue, codret
112 c 0.4. ==> variables locales
114 integer lepent, lepen0
117 integer listar(9), listso(15), nomiar(9)
118 #ifdef _DEBUG_HOMARD_
123 parameter ( nbmess = 20 )
124 character*80 texte(nblang,nbmess)
126 c 0.5. ==> initialisations
127 c ______________________________________________________________________
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,texte(langue,1)) 'Entree', nompro
140 #ifdef _DEBUG_HOMARD_
141 write(ulsort,90002) 'nbpecf, nbpeca =', nbpecf, nbpeca
149 c 2. initialisations des renumerotations
152 do 21 , iaux = 1 , rspeto
156 do 22 , iaux = 1 , nbele0
161 c 3. Conversion en lineaire
164 if ( degre.eq.1 ) then
167 c x------------------------------------------x
176 c x------------------------------------------x
180 c x------------------------------------------x
182 c La face f1 est le triangle (S1,S2,S3).
183 c La face f2 est le triangle (S4,S6,S5).
184 c La face fi, 3<=i<=5, est le quadrangle s'appuyant sur l'arete ai-2.
186 do 31 , lepen0 = 1 , nbpeto
190 #ifdef _DEBUG_HOMARD_
191 write (ulsort,texte(langue,11)) mess14(langue,2,7), lepent
194 etat = mod( hetpen(lepent) , 100 )
196 if ( etat.eq.0 .or. hierar.ne.0 ) then
199 #ifdef _DEBUG_HOMARD_
200 if ( elemen.eq.-12 ) then
206 #ifdef _DEBUG_HOMARD_
207 if ( glop.ne.0 ) then
208 write (ulsort,texte(langue,14)) elemen
211 npesho(elemen) = lepent
212 npesca(lepent) = elemen
214 call utaspe ( lepent,
215 > nbquto, nbpecf, nbpeca,
217 > facpen, cofape, arepen,
220 c Attention : utaspe donne la numerotation dans la convention homard
221 c il faut permuter les sommets 2/3 et 5/6 pour obtenir
222 c la numerotation dans la convention med
224 noeele(elemen,1) = nnosca(listso(1))
225 noeele(elemen,2) = nnosca(listso(3))
226 noeele(elemen,3) = nnosca(listso(2))
227 noeele(elemen,4) = nnosca(listso(4))
228 noeele(elemen,5) = nnosca(listso(6))
229 noeele(elemen,6) = nnosca(listso(5))
231 famele(elemen) = cfapen(cofamd,fampen(lepent))
232 typele(elemen) = cfapen(cotyel,fampen(lepent))
234 #ifdef _DEBUG_HOMARD_
235 if ( glop.ne.0 ) then
236 write (ulsort,90002) 'fampen', fampen(lepent)
237 write (ulsort,texte(langue,14)) elemen
238 write (ulsort,texte(langue,15))
239 > (noeele(elemen,iaux),iaux=1,6)
240 write (ulsort,90002) 'Famille MED',famele(elemen)
241 write (ulsort,90002) 'Type MED ',typele(elemen)
250 c 4. Conversion en quadratique
256 c x------------------------------------------x
265 c x------------------------------------------x
269 c N9 x------------------------------------------x
271 c La face f1 est le triangle (S1,S2,S3).
272 c La face f2 est le triangle (S4,S6,S5).
273 c La face fi, 3<=i<=5, est le quadrangle s'appuyant sur l'arete ai-2.
275 c Au sens homard au sens MED
276 c arete 1 de s1 a s3 | de s1 a s2
277 c arete 2 de s1 a s2 | de s1 a s3
278 c arete 3 de s2 a s3 | de s2 a s3
279 c arete 4 de s4 a s6 | de s4 a s5
280 c arete 5 de s4 a s5 | de s4 a s6
281 c arete 6 de s5 a s6 | de s5 a s6
282 c arete 7 de s1 a s4 | de s1 a s4
283 c arete 8 de s2 a s5 | de s3 a s6
284 c arete 9 de s3 a s6 | de s2 a s5
285 c Tableau de travail nomiar :
286 c nomiar(i) contient le numero local au sens MED du noeud porte
287 c par l'arete de numero local i au sens homard
299 do 41 , lepen0 = 1 , nbpeto
303 #ifdef _DEBUG_HOMARD_
304 if ( elemen.eq.-12 ) then
311 #ifdef _DEBUG_HOMARD_
312 write (ulsort,texte(langue,11)) mess14(langue,2,7), lepent
315 etat = mod( hetpen(lepent) , 100 )
317 if ( etat.eq.0 .or. hierar.ne.0 ) then
320 #ifdef _DEBUG_HOMARD_
321 if ( glop.ne.0 ) then
322 write (ulsort,texte(langue,14)) elemen
325 npesho(elemen) = lepent
326 npesca(lepent) = elemen
327 cgn write (ulsort,555) 'tria', (facpen(lepent,iaux),iaux=1,2)
328 cgn write (ulsort,555) 'quad',facpen(lepent,3),cofape(lepent,3)
329 cgn write (ulsort,555) '-> ',(arequa(facpen(lepent,3),iaux),iaux=1,4)
330 cgn write (ulsort,555) 'quad',facpen(lepent,4),cofape(lepent,4)
331 cgn write (ulsort,555) '-> ',(arequa(facpen(lepent,4),iaux),iaux=1,4)
332 cgn write (ulsort,555) 'quad',facpen(lepent,5),cofape(lepent,5)
333 cgn write (ulsort,555) '-> ',(arequa(facpen(lepent,5),iaux),iaux=1,4)
335 call utaspe ( lepent,
336 > nbquto, nbpecf, nbpeca,
338 > facpen, cofape, arepen,
341 c Attention : utaspe donne la numerotation dans la convention homard
342 c il faut permuter les sommets 2/3 et 5/6 pour obtenir
343 c la numerotation dans la convention med
345 cgn write (ulsort,555) 'listso',(listso(iaux),iaux=1,6)
346 noeele(elemen,1) = nnosca(listso(1))
347 noeele(elemen,2) = nnosca(listso(3))
348 noeele(elemen,3) = nnosca(listso(2))
349 noeele(elemen,4) = nnosca(listso(4))
350 noeele(elemen,5) = nnosca(listso(6))
351 noeele(elemen,6) = nnosca(listso(5))
352 cgn write (ulsort,555) '--> so',(noeele(elemen,iaux),iaux=1,6)
354 c Les noeuds au milieu des aretes
356 do 411 , iaux = 1 , 9
357 noeele(elemen,nomiar(iaux)) = nnosca(np2are(listar(iaux)))
359 cgn write (ulsort,555) 'p2',(noeele(elemen,nomiar(iaux)),iaux=1,9)
361 cgn 555 format(a,10i3)
362 famele(elemen) = cfapen(cofamd,fampen(lepent))
363 typele(elemen) = cfapen(cotyel,fampen(lepent))
375 if ( codret.ne.0 ) then
379 write (ulsort,texte(langue,1)) 'Sortie', nompro
380 write (ulsort,texte(langue,2)) codret
384 #ifdef _DEBUG_HOMARD_
385 write (ulsort,texte(langue,1)) 'Sortie', nompro