1 subroutine pcs2h2 ( nbfop2, profho, vap2ho,
4 > tbarcp, nbarhi, areint,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c aPres adaptation - Conversion de Solution -
28 c interpolation p2 sur les noeuds - decoupage Hexaedres - 2
30 c Du centre aux milieux d'aretes
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . nbfop2 . e . 1 . nombre de fonctions P2 .
36 c . profho . es . * . pour chaque entite en numerotation homard :.
37 c . . . . 0 : l'entite est absente du profil .
38 c . . . . 1 : l'entite est presente dans le profil .
39 c . vap2ho . es . nbfop2*. variables p2 numerotation homard .
41 c . somare . e .2*nbarto. numeros des extremites d'arete .
42 c . np2are . e . nbarto . numero des noeuds p2 milieux d'aretes .
43 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
44 c . filhex . e . nbheto . premier fils des hexaedres .
45 c . fhpyte . e .2*nbheco. fhpyte(1,j) = numero de la 1ere pyramide .
46 c . . . . fille de l'hexaedre k tel que filhex(k) =-j.
47 c . . . . fhpyte(2,j) = numero du 1er tetraedre .
48 c . . . . fils de l'hexaedre k tel que filhex(k) = -j.
49 c . listso . e . 8 . liste des sommets de l'hexaedre .
50 c . listno . e . 12 . liste des noeuds de l'hexaedre .
51 c . tbarcp . e . 12 . 1/0 pour chaque arete coupee ou non .
52 c . nbarhi . e . 1 . nombre d'aretes internes .
53 c . areint . e . * . numeros globaux des aretes internes .
54 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
55 c . langue . e . 1 . langue des messages .
56 c . . . . 1 : francais, 2 : anglais .
57 c . codret . es . 1 . code de retour des modules .
58 c . . . . 0 : pas de probleme .
59 c . . . . 1 : probleme .
60 c ______________________________________________________________________
63 c 0. declarations et dimensionnement
66 c 0.1. ==> generalites
76 parameter ( nompro = 'PCS2H2' )
90 integer somare(2,nbarto), np2are(nbarto)
91 integer listso(8), listno(12)
92 integer tbarcp(12), nbarhi, areint(nbarhi)
94 double precision vap2ho(nbfop2,*)
96 integer ulsort, langue, codret
98 c 0.4. ==> variables locales
108 parameter ( nbmess = 100 )
109 character*80 texte(nblang,nbmess)
111 c ______________________________________________________________________
117 cgn write (ulsort,texte(langue,1)) 'Entree', nompro
118 #ifdef _DEBUG_HOMARD_
119 write (ulsort,90002) 'listso', listso
120 write (ulsort,90002) 'listno 1-8', (listno(iaux),iaux=1,8)
121 write (ulsort,90002) 'listno 9-12', (listno(iaux),iaux=9,12)
122 write (ulsort,90002) 'tbarcp 1-8', (tbarcp(iaux),iaux=1,8)
123 write (ulsort,90002) 'tbarcp 9-12', (tbarcp(iaux),iaux=9,12)
125 c On passe en revue toutes les aretes coupees
127 do 10 , nuloar = 1 , 12
129 if ( tbarcp(nuloar).eq.1 ) then
132 c 1. Reperage des sommets et des noeuds
134 c le milieu de l'arete coupee
135 listns( 9) = listno(nuloar)
136 c le milieu de l'arete opposee
137 listns(20) = listno(13-nuloar)
141 if ( nuloar.eq.1 ) then
143 c les sommets de l'arete coupee
144 listns( 1) = listso(1)
145 listns( 2) = listso(2)
147 listns( 3) = listso(3)
148 listns( 4) = listso(4)
149 listns( 5) = listso(5)
150 listns( 6) = listso(6)
151 c les sommets de l'arete opposee a l'arete coupee
152 listns( 7) = listso(7)
153 listns( 8) = listso(8)
154 c les milieux des aretes proches
155 listns(10) = listno( 2)
156 listns(11) = listno( 3)
157 listns(12) = listno( 5)
158 listns(13) = listno( 6)
159 c les milieux des aretes paralleles
160 listns(14) = listno( 4)
161 listns(15) = listno( 9)
162 c les milieux des aretes moins proches
163 listns(16) = listno( 7)
164 listns(17) = listno( 8)
165 listns(18) = listno(10)
166 listns(19) = listno(11)
170 elseif ( nuloar.eq.2 ) then
172 c les sommets de l'arete coupee
173 listns( 1) = listso(1)
174 listns( 2) = listso(4)
176 listns( 3) = listso(2)
177 listns( 4) = listso(3)
178 listns( 5) = listso(6)
179 listns( 6) = listso(7)
180 c les sommets de l'arete opposee a l'arete coupee
181 listns( 7) = listso(5)
182 listns( 8) = listso(8)
183 c les milieux des aretes proches
184 listns(10) = listno( 1)
185 listns(11) = listno( 4)
186 listns(12) = listno( 5)
187 listns(13) = listno( 7)
188 c les milieux des aretes paralleles
189 listns(14) = listno( 3)
190 listns(15) = listno(10)
191 c les milieux des aretes moins proches
192 listns(16) = listno( 6)
193 listns(17) = listno( 8)
194 listns(18) = listno( 9)
195 listns(19) = listno(12)
199 elseif ( nuloar.eq.3 ) then
201 c les sommets de l'arete coupee
202 listns( 1) = listso(2)
203 listns( 2) = listso(3)
205 listns( 3) = listso(1)
206 listns( 4) = listso(4)
207 listns( 5) = listso(5)
208 listns( 6) = listso(8)
209 c les sommets de l'arete opposee a l'arete coupee
210 listns( 7) = listso(6)
211 listns( 8) = listso(7)
212 c les milieux des aretes proches
213 listns(10) = listno( 1)
214 listns(11) = listno( 4)
215 listns(12) = listno( 6)
216 listns(13) = listno( 8)
217 c les milieux des aretes paralleles
218 listns(14) = listno( 2)
219 listns(15) = listno(11)
220 c les milieux des aretes moins proches
221 listns(16) = listno( 5)
222 listns(17) = listno( 7)
223 listns(18) = listno( 9)
224 listns(19) = listno(12)
228 elseif ( nuloar.eq.4 ) then
230 c les sommets de l'arete coupee
231 listns( 1) = listso(3)
232 listns( 2) = listso(4)
234 listns( 3) = listso(1)
235 listns( 4) = listso(2)
236 listns( 5) = listso(7)
237 listns( 6) = listso(8)
238 c les sommets de l'arete opposee a l'arete coupee
239 listns( 7) = listso(5)
240 listns( 8) = listso(6)
241 c les milieux des aretes proches
242 listns(10) = listno( 2)
243 listns(11) = listno( 3)
244 listns(12) = listno( 7)
245 listns(13) = listno( 8)
246 c les milieux des aretes paralleles
247 listns(14) = listno( 1)
248 listns(15) = listno(12)
249 c les milieux des aretes moins proches
250 listns(16) = listno( 5)
251 listns(17) = listno( 6)
252 listns(18) = listno(10)
253 listns(19) = listno(11)
257 elseif ( nuloar.eq.5 ) then
259 c les sommets de l'arete coupee
260 listns( 1) = listso(1)
261 listns( 2) = listso(6)
263 listns( 3) = listso(2)
264 listns( 4) = listso(4)
265 listns( 5) = listso(5)
266 listns( 6) = listso(7)
267 c les sommets de l'arete opposee a l'arete coupee
268 listns( 7) = listso(3)
269 listns( 8) = listso(8)
270 c les milieux des aretes proches
271 listns(10) = listno( 1)
272 listns(11) = listno( 2)
273 listns(12) = listno( 9)
274 listns(13) = listno(10)
275 c les milieux des aretes paralleles
276 listns(14) = listno( 6)
277 listns(15) = listno( 7)
278 c les milieux des aretes moins proches
279 listns(16) = listno( 3)
280 listns(17) = listno( 4)
281 listns(18) = listno(11)
282 listns(19) = listno(12)
286 elseif ( nuloar.eq.6 ) then
288 c les sommets de l'arete coupee
289 listns( 1) = listso(2)
290 listns( 2) = listso(5)
292 listns( 3) = listso(1)
293 listns( 4) = listso(3)
294 listns( 5) = listso(6)
295 listns( 6) = listso(8)
296 c les sommets de l'arete opposee a l'arete coupee
297 listns( 7) = listso(4)
298 listns( 8) = listso(7)
299 c les milieux des aretes proches
300 listns(10) = listno( 1)
301 listns(11) = listno( 3)
302 listns(12) = listno( 9)
303 listns(13) = listno(11)
304 c les milieux des aretes paralleles
305 listns(14) = listno( 5)
306 listns(15) = listno( 8)
307 c les milieux des aretes moins proches
308 listns(16) = listno( 2)
309 listns(17) = listno( 4)
310 listns(18) = listno(10)
311 listns(19) = listno(12)
315 elseif ( nuloar.eq.7 ) then
317 c les sommets de l'arete coupee
318 listns( 1) = listso(4)
319 listns( 2) = listso(7)
321 listns( 3) = listso(1)
322 listns( 4) = listso(3)
323 listns( 5) = listso(6)
324 listns( 6) = listso(8)
325 c les sommets de l'arete opposee a l'arete coupee
326 listns( 7) = listso(2)
327 listns( 8) = listso(5)
328 c les milieux des aretes proches
329 listns(10) = listno( 2)
330 listns(11) = listno( 4)
331 listns(12) = listno(10)
332 listns(13) = listno(12)
333 c les milieux des aretes paralleles
334 listns(14) = listno( 5)
335 listns(15) = listno( 8)
336 c les milieux des aretes moins proches
337 listns(16) = listno( 1)
338 listns(17) = listno( 3)
339 listns(18) = listno( 9)
340 listns(19) = listno(11)
344 elseif ( nuloar.eq.8 ) then
346 c les sommets de l'arete coupee
347 listns( 1) = listso(3)
348 listns( 2) = listso(8)
350 listns( 3) = listso(2)
351 listns( 4) = listso(4)
352 listns( 5) = listso(5)
353 listns( 6) = listso(7)
354 c les sommets de l'arete opposee a l'arete coupee
355 listns( 7) = listso(1)
356 listns( 8) = listso(6)
357 c les milieux des aretes proches
358 listns(10) = listno( 3)
359 listns(11) = listno( 4)
360 listns(12) = listno(11)
361 listns(13) = listno(12)
362 c les milieux des aretes paralleles
363 listns(14) = listno( 6)
364 listns(15) = listno( 7)
365 c les milieux des aretes moins proches
366 listns(16) = listno( 1)
367 listns(17) = listno( 2)
368 listns(18) = listno( 9)
369 listns(19) = listno(10)
373 elseif ( nuloar.eq.9 ) then
375 c les sommets de l'arete coupee
376 listns( 1) = listso(5)
377 listns( 2) = listso(6)
379 listns( 3) = listso(1)
380 listns( 4) = listso(2)
381 listns( 5) = listso(7)
382 listns( 6) = listso(8)
383 c les sommets de l'arete opposee a l'arete coupee
384 listns( 7) = listso(3)
385 listns( 8) = listso(4)
386 c les milieux des aretes proches
387 listns(10) = listno( 5)
388 listns(11) = listno( 6)
389 listns(12) = listno(10)
390 listns(13) = listno(11)
391 c les milieux des aretes paralleles
392 listns(14) = listno( 1)
393 listns(15) = listno(12)
394 c les milieux des aretes moins proches
395 listns(16) = listno( 2)
396 listns(17) = listno( 3)
397 listns(18) = listno( 7)
398 listns(19) = listno( 8)
402 elseif ( nuloar.eq.10 ) then
404 c les sommets de l'arete coupee
405 listns( 1) = listso(6)
406 listns( 2) = listso(7)
408 listns( 3) = listso(1)
409 listns( 4) = listso(4)
410 listns( 5) = listso(5)
411 listns( 6) = listso(8)
412 c les sommets de l'arete opposee a l'arete coupee
413 listns( 7) = listso(2)
414 listns( 8) = listso(3)
415 c les milieux des aretes proches
416 listns(10) = listno( 5)
417 listns(11) = listno( 7)
418 listns(12) = listno( 9)
419 listns(13) = listno(12)
420 c les milieux des aretes paralleles
421 listns(14) = listno( 2)
422 listns(15) = listno(11)
423 c les milieux des aretes moins proches
424 listns(16) = listno( 1)
425 listns(17) = listno( 4)
426 listns(18) = listno( 6)
427 listns(19) = listno( 8)
431 elseif ( nuloar.eq.11 ) then
433 c les sommets de l'arete coupee
434 listns( 1) = listso(5)
435 listns( 2) = listso(8)
437 listns( 3) = listso(2)
438 listns( 4) = listso(3)
439 listns( 5) = listso(6)
440 listns( 6) = listso(7)
441 c les sommets de l'arete opposee a l'arete coupee
442 listns( 7) = listso(1)
443 listns( 8) = listso(4)
444 c les milieux des aretes proches
445 listns(10) = listno( 6)
446 listns(11) = listno( 8)
447 listns(12) = listno( 9)
448 listns(13) = listno(12)
449 c les milieux des aretes paralleles
450 listns(14) = listno( 3)
451 listns(15) = listno(10)
452 c les milieux des aretes moins proches
453 listns(16) = listno( 1)
454 listns(17) = listno( 4)
455 listns(18) = listno( 5)
456 listns(19) = listno( 7)
460 elseif ( nuloar.eq.12 ) then
462 c les sommets de l'arete coupee
463 listns( 1) = listso(7)
464 listns( 2) = listso(8)
466 listns( 3) = listso(3)
467 listns( 4) = listso(4)
468 listns( 5) = listso(5)
469 listns( 6) = listso(6)
470 c les sommets de l'arete opposee a l'arete coupee
471 listns( 7) = listso(1)
472 listns( 8) = listso(2)
473 c les milieux des aretes proches
474 listns(10) = listno( 7)
475 listns(11) = listno( 8)
476 listns(12) = listno(10)
477 listns(13) = listno(11)
478 c les milieux des aretes paralleles
479 listns(14) = listno( 4)
480 listns(15) = listno( 9)
481 c les milieux des aretes moins proches
482 listns(16) = listno( 2)
483 listns(17) = listno( 3)
484 listns(18) = listno( 5)
485 listns(19) = listno( 6)
490 c 2. L'arete concernee : celle des aretes internes qui demarrent
491 c sur le milieu de l'arete coupee
494 do 22 , iaux = 1 , nbarhi
495 larete = areint(iaux)
496 if ( somare(1,larete).eq.listns( 9) ) then
501 write(ulsort,*) nompro//' - aucune arete interne ne correspond ?'
510 if ( codret.eq.0 ) then
514 do 31, nuv = 1 , nbfop2
515 cgn do 311 , jaux =1 ,20
516 cgn write(*,90014) listns(jaux), vap2ho(nuv,listns(jaux))
519 vap2ho(nuv,sm) = - nfstr2 * ( vap2ho(nuv,listns(1))
520 > + vap2ho(nuv,listns(2)) )
521 > - trssz * ( vap2ho(nuv,listns(3))
522 > + vap2ho(nuv,listns(4))
523 > + vap2ho(nuv,listns(5))
524 > + vap2ho(nuv,listns(6)) )
525 > - trstr2 * ( vap2ho(nuv,listns(7))
526 > + vap2ho(nuv,listns(8)) )
527 > + nessz * vap2ho(nuv,listns(9))
528 > + nfstr2 * ( vap2ho(nuv,listns(10))
529 > + vap2ho(nuv,listns(11))
530 > + vap2ho(nuv,listns(12))
531 > + vap2ho(nuv,listns(13)) )
532 > + trssz * ( vap2ho(nuv,listns(14))
533 > + vap2ho(nuv,listns(15)) )
534 > + trstr2 * ( vap2ho(nuv,listns(16))
535 > + vap2ho(nuv,listns(17))
536 > + vap2ho(nuv,listns(18))
537 > + vap2ho(nuv,listns(19)) )
538 > + unssz * vap2ho(nuv,listns(20))
540 cgn write(*,*) 'vap2ho(nuv,',sm,') =',vap2ho(nuv,sm)
553 if ( codret.ne.0 ) then
557 write (ulsort,texte(langue,1)) 'Sortie', nompro
558 write (ulsort,texte(langue,2)) codret
562 #ifdef _DEBUG_HOMARD_
563 write (ulsort,texte(langue,1)) 'Sortie', nompro