1 subroutine pcete1 ( nbfonc, ngauss, deraff,
5 > nbante, anfite, anhete,
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 ______________________________________________________________________
28 c aPres adaptation - Conversion de solution - aux noeuds par Element
30 c TEtraedres - degre 1
32 c ______________________________________________________________________
34 c remarque : cette interpolation suppose que l'on est en presence de
35 c variables intensives. C'est-a-dire independantes de la
36 c taille de la maille.
37 c Une densite par exemple mais pas une masse.
38 c ______________________________________________________________________
40 c . nom . e/s . taille . description .
41 c .____________________________________________________________________.
42 c . nbfonc . e . 1 . nombre de fonctions aux points de Gauss .
43 c . ngauss . e . 1 . nbre de points de Gauss des fonctions pg .
44 c . deraff . e . 1 . vrai, s'il y a eu du deraffinement en .
45 c . . . . passant de l'iteration n a n+1 ; faux sinon.
46 c . prfcan . e . * . En numero du calcul a l'iteration n : .
47 c . . . . 0 : l'entite est absente du profil .
48 c . . . . i : l'entite est au rang i dans le profil .
49 c . prfcap . es . * . En numero du calcul a l'iteration n+1 : .
50 c . . . . 0 : l'entite est absente du profil .
51 c . . . . 1 : l'entite est presente dans le profil .
52 c . hettet . e . nbteto . historique de l'etat des tetraedres .
53 c . filtet . e . nbteto . premier fils des tetraedres .
54 c . nbante . e . 1 . nombre de tetraedres decoupes par .
55 c . . . . conformite sur le maillage avant adaptation.
56 c . anfite . e . nbante . tableau filtet du maillage de l'iteration n.
57 c . anhete . e . nbante . tableau hettet du maillage de l'iteration n.
58 c . nteeca . e . * . numero des tetraedres dans le calcul entree.
59 c . ntesca . e . rsteto . numero des tetraedres dans le calcul sortie.
60 c . vafoen . e . nbfonc*. variables en entree de l'adaptation .
62 c . vafott . a . nbfonc*. tableau temporaire de la solution .
64 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
65 c . langue . e . 1 . langue des messages .
66 c . . . . 1 : francais, 2 : anglais .
67 c . codret . es . 1 . code de retour des modules .
68 c . . . . 0 : pas de probleme .
69 c . . . . 1 : probleme .
70 c ______________________________________________________________________
73 c 0. declarations et dimensionnement
76 c 0.1. ==> generalites
82 parameter ( nompro = 'PCETE1' )
99 integer prfcan(*), prfcap(*)
100 integer hettet(nbteto), anctet(*)
101 integer filtet(nbteto)
102 integer nbante, anfite(nbante), anhete(nbante)
103 integer nteeca(reteto), ntesca(rsteto)
105 double precision vafoen(*)
106 double precision vafott(*)
110 integer ulsort, langue, codret
112 c 0.4. ==> variables locales
116 c tehn = TEtraedre courant en numerotation Homard a l'it. N
117 c tehnp1 = TEtraedre courant en numerotation Homard a l'it. N+1
121 c etan = ETAt du tetraedre a l'iteration N
122 c etanp1 = ETAt du tetraedre a l'iteration N+1
127 parameter ( nbmess = 10 )
128 character*80 texte(nblang,nbmess)
130 c 0.5. ==> initialisations
131 c ______________________________________________________________________
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,1)) 'Entree', nompro
146 c ______________________________________________________________________
149 c 2. on boucle sur tous les tetraedres du maillage HOMARD n+1
150 c on trie en fonction de l'etat du tetraedre dans le maillage n
151 c on numerote les paragraphes en fonction de la documentation, a
152 c savoir : le paragraphe doc.n.p traite de la mise a jour de solution
153 c pour un tetraedre dont l'etat est passe de n a p.
154 c les autres paragraphes sont numerotes classiquement
155 c remarque : on a scinde en plusieurs programmes pour pouvoir passer
156 c les options de compilation optimisees.
159 if ( nbfonc.ne.0 ) then
161 do 20 , tehnp1 = 1 , nbteto
163 c 2.1. ==> caracteristiques du tetraedre :
164 c 2.1.1. ==> son numero homard dans le maillage precedent
167 tehn = anctet(tehnp1)
172 c 2.1.2. ==> l'historique de son etat
173 c On rappelle que l'etat vaut :
174 c etan = 0 : le tetraedre etait actif.
175 c etan = 21, ..., 26 : le tetraedre etait coupe en 2 selon
176 c l'arete 1, ..., 6 ; il y a eu deraffinement.
177 c etan = 41, ..., 44 : le tetraedre etait coupe en 4 selon la
178 c face 1, ..., 4 ; il y a eu deraffinement.
179 c etan = 45, 46, 47 : le tetraedre etait coupe en 4 selon la
180 c diagonale 1-6, 2-5, 3-4 ; il y a eu
182 c etan = 55 : le tetraedre n'existait pas ; il a ete produit par
184 c etan = 85, 86, 87 : le tetraedre etait coupe en 8 selon la
185 c diagonale 1-6, 2-5, 3-4 ; il y a eu
188 etanp1 = mod(hettet(tehnp1),100)
189 etan = (hettet(tehnp1)-etanp1) / 100
191 cgn write (ulsort,1792) 'Tetraedre', tehn, etan, tehnp1, etanp1
193 c=======================================================================
194 c doc.0.p. ==> etan = 0 : le tetraedre etait actif
195 c=======================================================================
197 if ( etan.eq.0 ) then
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,texte(langue,3)) 'PCSPT0', nompro
203 call pcspt0 ( etan, etanp1, tehn, tehnp1,
207 > nbfonc, ngauss, vafoen, vafott,
208 > ulsort, langue, codret )
210 c=======================================================================
211 c doc.21-26.p. ==> etan = 21, ..., 26 : le tetraedre etait coupe en 2
212 c=======================================================================
214 elseif ( etan.ge.21 .and. etan.le.26 ) then
216 #ifdef _DEBUG_HOMARD_
217 write (ulsort,texte(langue,3)) 'PCSPT2', nompro
220 call pcspt2 ( etan, etanp1, tehn, tehnp1,
222 > hettet, filtet, nbante, anfite,
224 > nbfonc, ngauss, vafoen, vafott,
225 > ulsort, langue, codret )
227 c=======================================================================
228 c doc.41-44.p. ==> etan = 41, ..., 44 : le tetraedre etait coupe en 4
229 c selon la face 1, 2, 3, 4
230 c doc.45-47.p. ==> etan = 45, 46, 47 : le tetraedre etait coupe en 4
231 c selon une diagonale
232 c=======================================================================
234 elseif ( etan.ge.41 .and. etan.le.47 ) then
236 #ifdef _DEBUG_HOMARD_
237 write (ulsort,texte(langue,3)) 'PCSPT4', nompro
240 call pcspt4 ( etan, etanp1, tehn, tehnp1,
242 > hettet, filtet, nbante, anfite,
244 > nbfonc, ngauss, vafoen, vafott,
245 > ulsort, langue, codret )
247 c=======================================================================
248 c doc.85-87.p. ==> etan = 85, 86, 87 : le tetraedre etait coupe en 8
249 c selon une diagonale
250 c=======================================================================
252 elseif ( etan.ge.85 .and. etan.le.87 ) then
254 #ifdef _DEBUG_HOMARD_
255 write (ulsort,texte(langue,3)) 'PCSPT8', nompro
258 call pcspt8 ( etanp1, tehn, tehnp1,
260 > filtet, nbante, anfite,
262 > nbfonc, ngauss, vafoen, vafott,
263 > ulsort, langue, codret )
275 if ( codret.ne.0 ) then
279 write (ulsort,texte(langue,1)) 'Sortie', nompro
280 write (ulsort,texte(langue,2)) codret
284 #ifdef _DEBUG_HOMARD_
285 write (ulsort,texte(langue,1)) 'Sortie', nompro