1 subroutine pcseh9 ( etan, etanp1, hehn, hehnp1, typint,
2 > f1hp, nrofon, valeur, coef, prfcap,
4 > coonoe, somare, aretri, arequa,
5 > tritet, cotrte, aretet,
6 > quahex, coquhe, arehex,
7 > facpyr, cofapy, arepyr,
8 > hethex, filhex, fhpyte,
15 > ulsort, langue, codret )
16 c ______________________________________________________________________
20 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
22 c Version originale enregistree le 18 juin 1996 sous le numero 96036
23 c aupres des huissiers de justice Simart et Lavoir a Clamart
24 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
25 c aupres des huissiers de justice
26 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
28 c HOMARD est une marque deposee d'Electricite de France
34 c ______________________________________________________________________
36 c aPres adaptation - Conversion de Solution Elements de volume -
40 c ______________________________________________________________________
42 c . nom . e/s . taille . description .
43 c .____________________________________________________________________.
44 c . etan . e . 1 . ETAt de l'hexaedre a l'iteration N .
45 c . etanp1 . e . 1 . ETAt du hexaedre a l'iteration N+1 .
46 c . hehn . e . 1 . Hexaedre courant en numerotation Homard .
47 c . . . . a l'iteration N .
48 c . hehnp1 . e . 1 . Hexaedre courant en numerotation Homard .
49 c . . . . a l'iteration N+1 .
50 c . typint . e . 1 . type d'interpolation .
51 c . . . . 0, si automatique .
52 c . . . . elements : 0 si intensif, sans orientation.
53 c . . . . 1 si extensif, sans orientation.
54 c . . . . 2 si intensif, avec orientation.
55 c . . . . 3 si extensif, avec orientation.
56 c . . . . noeuds : 1 si degre 1 .
57 c . . . . 2 si degre 2 .
58 c . . . . 3 si iso-P2 .
59 c . f1hp . e . 1 . Fils 1er de l'hexaedre en numerotation .
60 c . . . . Homard a l'iteration N+1 .
61 c . nrofon . e . 1 . numero de la fonction en cours d'examen .
62 c . valeur . e . 1 . valeur de la fonction en cours d'examen .
63 c . coef . e . 1 . coefficient pour la moyenne .
64 c . prfcap . es . * . En numero du calcul a l'iteration n+1 : .
65 c . . . . 0 : l'entite est absente du profil .
66 c . . . . 1 : l'entite est presente dans le profil .
67 c . ficp . e . 3,18 . fils en numerotation du calcul n+1 .
68 c . . . . 1 : hexaedres .
69 c . . . . 2 : pyramides .
70 c . . . . 3 : tetraedres .
71 c . propor . e . 18 . proportion de volume entre fils et pere .
72 c . coonoe . e . nbnoto . coordonnees des noeuds .
74 c . somare . e .2*nbarto. numeros des extremites d'arete .
75 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
76 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
77 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
78 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
79 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
80 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
81 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
82 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
83 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
84 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
85 c . arepyr . e .nbpyca*8. numeros des 8 aretes des pyramides .
86 c . hethex . e . nbheto . historique de l'etat des hexaedres .
87 c . filhex . e . nbheto . premier fils des hexaedres .
88 c . fhpyte . e .2*nbheco. fhpyte(1,j) = numero de la 1ere pyramide .
89 c . . . . fille de l'hexaedre k tel que filhex(k) =-j.
90 c . . . . fhpyte(2,j) = numero du 1er tetraedre .
91 c . . . . fils de l'hexaedre k tel que filhex(k) = -j.
92 c . nhesca . e . rsteto . numero des hexaedres dans le calcul sortie .
93 c . ntesca . e . rsteto . numero des tetraedres dans le calcul sortie.
94 c . npysca . e . rspyto . numero des pyramides dans le calcul sortie .
95 c . nbfonc . e . 1 . nombre de fonctions elements de volume .
96 c . vafott . es . nbfonc*. variables en sortie de l'adaptation .
98 c . prftep . es . * . En numero du calcul a l'iteration n+1 : .
99 c . . . . 0 : le tetraedre est absent du profil .
100 c . . . . 1 : le tetraedre est present dans le profil.
101 c . vatett . a . nbfonc*. tableau temporaire de la solution pour .
102 c . . . * . les tetraedres .
103 c . prfpyp . es . * . En numero du calcul a l'iteration n+1 : .
104 c . . . . 0 : la pyramide est absente du profil .
105 c . . . . 1 : la pyramide est presente dans le profil
106 c . vapytt . a . nbfonc*. tableau temporaire de la solution pour .
107 c . . . * . les pyramides .
108 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
109 c . langue . e . 1 . langue des messages .
110 c . . . . 1 : francais, 2 : anglais .
111 c . codret . es . 1 . code de retour des modules .
112 c . . . . 0 : pas de probleme .
113 c . . . . 1 : probleme .
114 c ______________________________________________________________________
117 c 0. declarations et dimensionnement
120 c 0.1. ==> generalites
126 parameter ( nompro = 'PCSEH9' )
144 integer etan, etanp1, hehn, hehnp1
151 integer somare(2,nbarto)
152 integer aretri(nbtrto,3)
153 integer arequa(nbquto,4)
154 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
155 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
156 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
158 integer hethex(nbheto)
159 integer filhex(nbheto), fhpyte(2,nbheco)
160 integer nhesca(rsheto)
161 integer ntesca(rsteto)
162 integer npysca(rspyto)
166 double precision valeur, coef
168 double precision propor(18)
169 double precision coonoe(nbnoto,sdim)
170 double precision vafott(nbfonc,*)
171 double precision vatett(nbfonc,*)
172 double precision vapytt(nbfonc,*)
174 integer ulsort, langue, codret
176 c 0.4. ==> variables locales
183 integer nfhexf, nfpyrf, nftetf
186 double precision daux
187 double precision propof(18)
190 parameter ( nbmess = 10 )
191 character*80 texte(nblang,nbmess)
193 c 0.5. ==> initialisations
194 c ______________________________________________________________________
202 #ifdef _DEBUG_HOMARD_
203 write (ulsort,texte(langue,1)) 'Entree', nompro
208 >'(/,''Hexa. en cours : numero a l''''iteration '',a3,'' : '',i10)'
210 >'( '' etat a l''''iteration '',a3,'' : '',i4)'
213 >'(/,''Current hexahedron : # at iteration '',a3,'' : '',i10)'
215 > '( '' status at iteration '',a3,'' : '',i4)'
218 c 2. Exploration des 8 fils
223 if ( codret.eq.0 ) then
226 etatfi = mod(hethex(fihp),1000)
227 cgn write (ulsort,*) '. fihp', fihp,', etat =', hethex(fihp)
229 c 2.1. ==> Le fils est actif
231 if ( etatfi.eq.0 ) then
233 if ( typint.eq.0 ) then
236 daux = valeur*propor(iaux+1)
238 cgn write (ulsort,*) '. ficp', ficp(1,iaux+1)
239 vafott(nrofon,ficp(1,iaux+1)) = daux
240 prfcap(ficp(1,iaux+1)) = 1
242 c 2.2. ==> Le fils est coupe en conformite
244 elseif ( etatfi.ge.11 ) then
246 #ifdef _DEBUG_HOMARD_
247 write (ulsort,texte(langue,3)) 'PCSEHY', nompro
249 call pcsehy ( nfhexf, nfpyrf, nftetf, ficf,
252 > nhesca, ntesca, npysca,
253 > ulsort, langue, codret )
255 if ( typint.eq.0 ) then
258 do 2203 , jaux = 1 , nfpyrf
259 vapytt(nrofon,ficf(2,jaux)) = daux
261 do 2204 , jaux = 1 , nftetf
262 vatett(nrofon,ficf(3,jaux)) = daux
267 #ifdef _DEBUG_HOMARD_
268 write (ulsort,texte(langue,3)) 'PCSEHZ', nompro
270 call pcsehz ( propof,
272 > coonoe, somare, aretri, arequa,
273 > tritet, cotrte, aretet,
274 > quahex, coquhe, arehex,
275 > facpyr, cofapy, arepyr,
277 > ulsort, langue, codret )
279 daux = valeur*propor(iaux+1)
280 do 2213 , jaux = 1 , nfpyrf
281 vapytt(nrofon,ficf(2,jaux)) = daux * propof(jaux)
283 do 2214 , jaux = 1 , nftetf
284 vatett(nrofon,ficf(3,jaux)) = daux * propof(jaux+nfpyrf)
289 if ( codret.eq.0 ) then
291 do 222 , jaux = 1 , nfpyrf
292 prfpyp(ficf(2,jaux)) = 1
295 do 223 , jaux = 1 , nftetf
296 prftep(ficf(3,jaux)) = 1
304 write (ulsort,texte(langue,4)) 'n ', hehn
305 write (ulsort,texte(langue,5)) 'n ', etan
306 write (ulsort,texte(langue,4)) 'n+1', hehnp1
307 write (ulsort,texte(langue,5)) 'n+1', etanp1
319 if ( codret.ne.0 ) then
321 write (ulsort,texte(langue,1)) 'Sortie', nompro
322 write (ulsort,texte(langue,2)) codret
326 #ifdef _DEBUG_HOMARD_
327 write (ulsort,texte(langue,1)) 'Sortie', nompro