1 subroutine pcmapy ( elemen, nbele0,
4 > facpyr, cofapy, arepyr,
5 > hetpyr, fampyr, cfapyr,
6 > nnosca, npysca, npysho,
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
27 c ______________________________________________________________________
29 c aPres adaptation - Conversion - MAillage connectivite - PYramides
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . elemen . es . 1 . numero du dernier element cree .
36 c . nbele0 . e . 1 . estimation du nombre d'elements .
37 c . somare . e .2*nbarto. numeros des extremites d'arete .
38 c . np2are . e . nbarto . numero du noeud p2 milieu d'arete .
39 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
40 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
41 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
42 c . arepyr . e .nbpyca*8. numeros des 8 aretes des pyramides .
43 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
44 c . fampyr . e . nbpyto . famille des pyramides .
45 c . cfapyr . . nctfhe. codes des familles des pyramides .
46 c . . . nbfpyr . 1 : famille MED .
47 c . . . . 2 : type d'pyramides .
48 c . nnosca . e . rsnoto . numero des noeuds du code de calcul .
49 c . npysca . s . rspyto . numero des pyramides dans le calcul sortie .
50 c . npysho . s . nbele0 . numero des pyramides dans HOMARD .
51 c . famele . es . nbele0 . famille med des elements .
52 c . noeele . es . nbele0 . noeuds des elements .
54 c . typele . es . nbele0 . type des elements .
55 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
56 c . langue . e . 1 . langue des messages .
57 c . . . . 1 : francais, 2 : anglais .
58 c . codret . es . 1 . code de retour des modules .
59 c . . . . 0 : pas de probleme .
60 c . . . . 1 : probleme .
61 c ______________________________________________________________________
64 c 0. declarations et dimensionnement
67 c 0.1. ==> generalites
73 parameter ( nompro = 'PCMAPY' )
99 integer somare(2,nbarto), np2are(nbarto)
100 integer aretri(nbtrto,3)
101 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
102 integer hetpyr(nbpyto)
104 integer cfapyr(nctfpy,nbfpyr), fampyr(nbpyto)
106 integer nnosca(rsnoto)
107 integer npysca(rspyto), npysho(nbele0)
109 integer famele(nbele0), noeele(nbele0,nbmane)
110 integer typele(nbele0)
112 integer ulsort, langue, codret
114 c 0.4. ==> variables locales
116 integer lapyra, lapyr0
119 integer listar(8), listso(13), nomiar(8)
122 parameter ( nbmess = 20 )
123 character*80 texte(nblang,nbmess)
125 c 0.5. ==> initialisations
126 c ______________________________________________________________________
136 #ifdef _DEBUG_HOMARD_
137 write (ulsort,texte(langue,1)) 'Entree', nompro
141 #ifdef _DEBUG_HOMARD_
142 write(ulsort,90002) 'nbpycf, nbpyca', nbpycf, nbpyca
143 write(ulsort,90002) 'nbele0, nbmane', nbele0, nbmane
144 write(ulsort,90002) 'degre', degre
145 cgn write(ulsort,*) cfapyr
151 c 2. initialisations des renumerotations
154 do 21 , iaux = 1 , rspyto
158 do 22 , iaux = 1 , nbele0
163 c 3. Conversion en lineaire
166 if ( degre.eq.1 ) then
184 c x--------------------------------------------------------x
187 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
190 do 31 , lapyr0 = 1 , nbpyto
194 #ifdef _DEBUG_HOMARD_
195 write (ulsort,texte(langue,11)) mess14(langue,2,5), lapyra
198 etat = mod( hetpyr(lapyra) , 100 )
200 if ( etat.eq.0 .or. hierar.ne.0 ) then
203 #ifdef _DEBUG_HOMARD_
204 write (ulsort,texte(langue,14)) elemen
206 npysho(elemen) = lapyra
207 npysca(lapyra) = elemen
209 #ifdef _DEBUG_HOMARD_
210 write (ulsort,texte(langue,3)) 'UTASPY', nompro
212 call utaspy ( lapyra,
213 > nbtrto, nbpycf, nbpyca,
215 > facpyr, cofapy, arepyr,
218 cgn write (ulsort,90002) 'listar', (listar(iaux),iaux = 1 , 8)
219 cgn write (ulsort,90002) 'listso', (listso(iaux),iaux = 1 , 5)
221 c Attention : utaspy donne la numerotation dans la convention homard
222 c il faut permuter les sommets 2/4 pour obtenir
223 c la numerotation dans la convention med
225 noeele(elemen,1) = nnosca(listso(1))
226 noeele(elemen,2) = nnosca(listso(4))
227 noeele(elemen,3) = nnosca(listso(3))
228 noeele(elemen,4) = nnosca(listso(2))
229 noeele(elemen,5) = nnosca(listso(5))
231 famele(elemen) = cfapyr(cofamd,fampyr(lapyra))
232 typele(elemen) = cfapyr(cotyel,fampyr(lapyra))
234 #ifdef _DEBUG_HOMARD_
235 if ( noeele(elemen,1).ne.-54117 ) then
236 write (ulsort,*) 'fampyr = ', fampyr(lapyra)
237 write (ulsort,texte(langue,14)) elemen
238 write (ulsort,texte(langue,15))
239 > (noeele(elemen,iaux),iaux=1,5)
240 write (ulsort,*) 'Famille MED = ',famele(elemen),
241 > ', Type MED = ',typele(elemen)
250 c 4. Conversion en quadratique
271 c N9 x--------------------------------------------------------x
274 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
277 c Au sens homard au sens MED
278 c arete 1 de s1 a s5 | de s1 a s5
279 c arete 2 de s2 a s5 | de s4 a s5
280 c arete 3 de s3 a s5 | de s3 a s5
281 c arete 4 de s4 a s5 | de s2 a s5
282 c arete 5 de s1 a s2 | de s1 a s4
283 c arete 6 de s2 a s3 | de s4 a s3
284 c arete 7 de s3 a s4 | de s3 a s2
285 c arete 8 de s4 a s1 | de s2 a s1
286 c Tableau de travail nomiar :
287 c nomiar(i) contient le numero local au sens MED du noeud porte
288 c par l'arete de numero local i au sens homard
299 do 41 , lapyr0 = 1 , nbpyto
303 #ifdef _DEBUG_HOMARD_
304 write (ulsort,texte(langue,11)) mess14(langue,2,5), lapyra
307 etat = mod( hetpyr(lapyra) , 100 )
309 if ( etat.eq.0 .or. hierar.ne.0 ) then
312 #ifdef _DEBUG_HOMARD_
313 write (ulsort,texte(langue,14)) elemen
315 npysho(elemen) = lapyra
316 npysca(lapyra) = elemen
319 #ifdef _DEBUG_HOMARD_
320 write (ulsort,texte(langue,3)) 'UTASPY', nompro
322 call utaspy ( lapyra,
323 > nbtrto, nbpycf, nbpyca,
325 > facpyr, cofapy, arepyr,
328 cgn write (ulsort,90002) 'listar', (listar(iaux),iaux = 1 , 8)
329 cgn write (ulsort,90002) 'listso', (listso(iaux),iaux = 1 , 5)
331 c Attention : utaspy donne la numerotation dans la convention homard
332 c il faut permuter les sommets 2/4 pour obtenir la
333 c numerotation dans la convention med
335 noeele(elemen,1) = nnosca(listso(1))
336 noeele(elemen,2) = nnosca(listso(4))
337 noeele(elemen,3) = nnosca(listso(3))
338 noeele(elemen,4) = nnosca(listso(2))
339 noeele(elemen,5) = nnosca(listso(5))
341 c Les noeuds au milieu des aretes
343 do 411 , iaux = 1 , 8
344 noeele(elemen,nomiar(iaux)) = nnosca(np2are(listar(iaux)))
347 famele(elemen) = cfapyr(cofamd,fampyr(lapyra))
348 typele(elemen) = cfapyr(cotyel,fampyr(lapyra))
350 #ifdef _DEBUG_HOMARD_
351 if ( elemen.eq.-601 ) then
352 write (ulsort,*) 'fampyr = ', fampyr(lapyra)
353 write (ulsort,texte(langue,14)) elemen
354 write (ulsort,texte(langue,15))
355 > (noeele(elemen,iaux),iaux=1,13)
356 write (ulsort,*) 'Famille MED = ',famele(elemen),
357 > ', Type MED = ',typele(elemen)
371 if ( codret.ne.0 ) then
375 write (ulsort,texte(langue,1)) 'Sortie', nompro
376 write (ulsort,texte(langue,2)) codret
380 #ifdef _DEBUG_HOMARD_
381 write (ulsort,texte(langue,1)) 'Sortie', nompro