1 subroutine pcepe1 ( nbfonc, ngauss, deraff,
3 > hethex, anchex, filhex, fhpyte,
4 > nbanhe, anfihe, anhehe, anpthe,
9 > ulsort, langue, codret )
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
29 c aPres adaptation - Conversion de solution - aux noeuds par Element
31 c PEntaedres - degre 1
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . nbfonc . e . 1 . nombre de fonctions aux points de Gauss .
38 c . ngauss . e . 1 . nbre de points de Gauss des fonctions pg .
39 c . deraff . e . 1 . vrai, s'il y a eu du deraffinement en .
40 c . . . . passant de l'iteration n a n+1 ; faux sinon.
41 c . prfcan . e . * . En numero du calcul a l'iteration n : .
42 c . . . . 0 : l'entite est absente du profil .
43 c . . . . i : l'entite est au rang i dans le profil .
44 c . prfcap . es . * . En numero du calcul a l'iteration n+1 : .
45 c . . . . 0 : l'entite est absente du profil .
46 c . . . . 1 : l'entite est presente dans le profil .
47 c . hethex . e . nbheto . historique de l'etat des pentaedres .
48 c . filpen . e . nbpeto . premier fils des pentaedres .
49 c . fppyte . e .2*nbpeco. fppyte(1,j) = numero de la 1ere pyramide .
50 c . . . . fille du pentaedre k tel que filpen(k) =-j .
51 c . . . . fppyte(2,j) = numero du 1er tetraedre .
52 c . . . . fils du pentaedre k tel que filpen(k) = -j .
53 c . nbanhe . e . 1 . nombre de pentaedres decoupes par .
54 c . . . . conformite sur le maillage avant adaptation.
55 c . anfihe . e . nbanhe . tableau filhex du maillage de l'iteration n.
56 c . anhehe . e . nbanhe . tableau hethex du maillage de l'iteration n.
57 c . anpthe . e . 2** . tableau fhpyte du maillage de l'iteration n.
58 c . nheeca . e . * . pentaedres en entree dans le calcul .
59 c . nhesca . e . rsheto . numero des pentaedres dans le calcul .
60 c . nteeca . e . * . tetraedres en entree dans le calcul .
61 c . ntesca . e . rsteto . tetraedres en sortie dans le calcul .
62 c . npyeca . e . * . pyramides en entree dans le calcul .
63 c . npysca . e . rspyto . numero des pyramides dans le calcul sortie .
64 c . vafoen . e . nbfonc*. variables en entree de l'adaptation .
66 c . vafott . a . nbfonc*. tableau temporaire de la solution .
68 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
69 c . langue . e . 1 . langue des messages .
70 c . . . . 1 : francais, 2 : anglais .
71 c . codret . es . 1 . code de retour des modules .
72 c . . . . 0 : pas de probleme .
73 c . . . . 1 : probleme .
74 c ______________________________________________________________________
77 c 0. declarations et dimensionnement
80 c 0.1. ==> generalites
86 parameter ( nompro = 'PCEPE1' )
103 integer prfcan(*), prfcap(*)
104 integer hethex(nbheto), anchex(*)
105 integer filhex(nbheto), fhpyte(2,nbheco)
106 integer nbanhe, anfihe(nbanhe), anhehe(nbanhe), anpthe(2,*)
107 integer nheeca(reheto), nhesca(rsheto)
108 integer nteeca(reteto), ntesca(rsteto)
109 integer npyeca(repyto), npysca(rspyto)
111 double precision vafoen(*)
112 double precision vafott(*)
116 integer ulsort, langue, codret
118 c 0.4. ==> variables locales
122 c pehn = Pentaedre courant en numerotation Homard a l'it. N
123 c pehnp1 = Pentaedre courant en numerotation Homard a l'it. N+1
127 c etan = ETAt du pentaedre a l'iteration N
128 c etanp1 = ETAt du pentaedre a l'iteration N+1
133 parameter ( nbmess = 10 )
134 character*80 texte(nblang,nbmess)
136 c 0.5. ==> initialisations
137 c ______________________________________________________________________
146 #ifdef _DEBUG_HOMARD_
147 write (ulsort,texte(langue,1)) 'Entree', nompro
152 c ______________________________________________________________________
155 c 2. on boucle sur tous les pentaedres du maillage HOMARD n+1
156 c on trie en fonction de l'etat de l'pentaedre dans le maillage n
157 c remarque : on a scinde en plusieurs programmes pour pouvoir passer
158 c les options de compilation optimisees.
161 if ( nbfonc.ne.0 ) then
163 do 20 , pehnp1 = 1 , nbheto
165 c 2.1. ==> caracteristiques de l'pentaedre :
166 c 2.1.1. ==> son numero homard dans le maillage precedent
169 pehn = anchex(pehnp1)
174 c 2.1.2. ==> l'historique de son etat
175 c On rappelle que l'etat vaut :
176 c etat = 0 : le pentaedre est actif.
177 c etat = 1, ..., 24 : l'pentaedre est coupe en 2 pyramides et
178 c 12 tetraedres ; il y a eu deraffinement.
179 c etat = 31, ..., 35 : l'pentaedre est coupe en 2 pyramides et
180 c 12 tetraedres ; il y a eu deraffinement.
181 c etat = 41, ..., 46 : l'pentaedre est coupe en 5 pyramides et
182 c 4 tetraedres selon la face 1, ..., 6 ; il y
183 c a eu deraffinement.
184 c etat = 61, ..., 72 : l'pentaedre est coupe en 4 pyramides selon
185 c l'arete 1, .., 12 ; il y a eu deraffinement.
186 c etat = 55 : l'pentaedre n'existait pas ; il a ete produit par
188 c etat = 80 : l'pentaedre est coupe en 8.
189 c etat = 81, ..., 88 : l'pentaedre est coupe en 18 tetraedres ; il
190 c y a eu deraffinement.
192 etanp1 = mod(hethex(pehnp1),1000)
193 etan = (hethex(pehnp1)-etanp1) / 1000
195 cgn write (ulsort,1792) 'Hexaedre', pehn, etan, pehnp1, etanp1
197 c=======================================================================
198 c 2.1. ==> etan = 0 : le pentaedre etait actif
199 c=======================================================================
210 if ( codret.ne.0 ) then
214 write (ulsort,texte(langue,1)) 'Sortie', nompro
215 write (ulsort,texte(langue,2)) codret
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,texte(langue,1)) 'Sortie', nompro