1 subroutine pcsep9 ( etan, etanp1, pehn, pehnp1, typint,
2 > f1hp, nrofon, valeur, coef, prfcap,
4 > coonoe, somare, aretri, arequa,
5 > tritet, cotrte, aretet,
6 > facpen, cofape, arepen,
7 > facpyr, cofapy, arepyr,
8 > hetpen, filpen, fppyte,
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 -
38 c Pentaedres d'etat 80
40 c ______________________________________________________________________
42 c . nom . e/s . taille . description .
43 c .____________________________________________________________________.
44 c . etan . e . 1 . ETAt du pentaedre a l'iteration N .
45 c . etanp1 . e . 1 . ETAt du pentaedre a l'iteration N+1 .
46 c . pehn . e . 1 . PEntaedre courant en numerotation Homard .
47 c . . . . a l'iteration N .
48 c . pehnp1 . e . 1 . PEntaedre 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 du pentaedre 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,11 . fils en numerotation du calcul n+1 .
68 c . . . . 1 : pentaedres .
69 c . . . . 2 : pyramides .
70 c . . . . 3 : tetraedres .
71 c . propor . e . 11 . 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 . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
81 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
82 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
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 . hetpen . e . nbpeto . historique de l'etat des pentaedres .
87 c . filpen . e . nbpeto . premier fils des pentaedres .
88 c . fppyte . e .2*nbpeco. fppyte(1,j) = numero de la 1ere pyramide .
89 c . . . . fille du pentaedre k tel que filpen(k) =-j .
90 c . . . . fppyte(2,j) = numero du 1er tetraedre .
91 c . . . . fils du pentaedre k tel que filpen(k) = -j .
92 c . npesca . e . rspeto . numero des pentaedres 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 = 'PCSEP9' )
144 integer etan, etanp1, pehn, pehnp1
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 facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
156 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
158 integer hetpen(nbpeto)
159 integer filpen(nbpeto), fppyte(2,nbpeco)
160 integer npesca(rsheto)
161 integer ntesca(rsteto)
162 integer npysca(rspyto)
166 double precision valeur, coef
168 double precision propor(11)
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 nfpenf, nfpyrf, nftetf
186 double precision daux
187 double precision propof(11)
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 >'(/,''Pent. en cours : numero a l''''iteration '',a3,'' : '',i10)'
210 >'( '' etat a l''''iteration '',a3,'' : '',i4)'
213 >'(/,''Current prism : # at iteration '',a3,'' : '',i10)'
215 > '( '' status at iteration '',a3,'' : '',i4)'
220 c 2. Exploration des 8 fils
225 if ( codret.eq.0 ) then
228 etatfi = mod(hetpen(fihp),100)
229 cgn write (ulsort,90015) 'fihp', fihp,', etat', hetpen(fihp)
231 c 2.1. ==> Le fils est actif
233 if ( etatfi.eq.0 ) then
235 if ( typint.eq.0 ) then
238 daux = valeur*propor(iaux+1)
240 cgn write (ulsort,*) '. ficp', ficp(1,iaux+1)
241 vafott(nrofon,ficp(1,iaux+1)) = daux
242 prfcap(ficp(1,iaux+1)) = 1
244 c 2.2. ==> Le fils est coupe en conformite
246 elseif ( ( etatfi.ge. 1 .and. etatfi.le. 6 ) .or.
247 > ( etatfi.ge.17 .and. etatfi.le.19 ) .or.
248 > ( etatfi.ge.21 .and. etatfi.le.26 ) .or.
249 > ( etatfi.ge.31 .and. etatfi.le.36 ) .or.
250 > ( etatfi.ge.43 .and. etatfi.le.45 ) .or.
251 > ( etatfi.ge.51 .and. etatfi.le.52 ) ) then
253 #ifdef _DEBUG_HOMARD_
254 write (ulsort,texte(langue,3)) 'PCSEPY', nompro
256 call pcsepy ( nfpenf, nfpyrf, nftetf, ficf,
259 > npesca, ntesca, npysca,
260 > ulsort, langue, codret )
262 if ( typint.eq.0 ) then
265 do 2203 , jaux = 1 , nfpyrf
266 vapytt(nrofon,ficf(2,jaux)) = daux
268 do 2204 , jaux = 1 , nftetf
269 vatett(nrofon,ficf(3,jaux)) = daux
274 #ifdef _DEBUG_HOMARD_
275 write (ulsort,texte(langue,3)) 'PCSEPZ', nompro
277 call pcsepz ( propof,
279 > coonoe, somare, aretri, arequa,
280 > tritet, cotrte, aretet,
281 > facpen, cofape, arepen,
282 > facpyr, cofapy, arepyr,
284 > ulsort, langue, codret )
286 daux = valeur*propor(iaux+1)
287 do 2213 , jaux = 1 , nfpyrf
288 vapytt(nrofon,ficf(2,jaux)) = daux * propof(jaux)
290 do 2214 , jaux = 1 , nftetf
291 vatett(nrofon,ficf(3,jaux)) = daux * propof(jaux+nfpyrf)
296 if ( codret.eq.0 ) then
298 do 222 , jaux = 1 , nfpyrf
299 prfpyp(ficf(2,jaux)) = 1
302 do 223 , jaux = 1 , nftetf
303 prftep(ficf(3,jaux)) = 1
311 write (ulsort,texte(langue,4)) 'n ', pehn
312 write (ulsort,texte(langue,5)) 'n ', etan
313 write (ulsort,texte(langue,4)) 'n+1', pehnp1
314 write (ulsort,texte(langue,5)) 'n+1', etanp1
326 if ( codret.ne.0 ) then
328 write (ulsort,texte(langue,1)) 'Sortie', nompro
329 write (ulsort,texte(langue,2)) codret
333 #ifdef _DEBUG_HOMARD_
334 write (ulsort,texte(langue,1)) 'Sortie', nompro