1 subroutine pcs2ar ( nbfop2, profho, vap2ho,
2 > hetare, somare, np2are, filare )
3 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c aPres adaptation - Conversion de Solution -
25 c interpolation p2 sur les noeuds lors du decoupage des ARetes
27 c remarque : pcs2ar et pcsiar sont des clones
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . nbfop2 . e . 1 . nombre de fonctions P2 .
33 c . profho . es . * . pour chaque entite en numerotation homard :.
34 c . . . . 0 : l'entite est absente du profil .
35 c . . . . 1 : l'entite est presente dans le profil .
36 c . vap2ho . es . nbfop2*. variables iso-p2 numerotation homard .
38 c . somare . e .2*nbarto. numeros des extremites d'arete .
39 c . np2are . e . nbarto . numero des noeuds p2 milieux d'aretes .
40 c . filare . e . nbarto . premiere fille des aretes .
41 c . hetare . e . nbarto . historique de l'etat des aretes .
42 c ______________________________________________________________________
45 c 0. declarations et dimensionnement
48 c 0.1. ==> generalites
64 integer profho(nbnoto)
65 integer hetare(nbarto), somare(2,nbarto), np2are(nbarto)
66 integer filare(nbarto)
68 double precision vap2ho(nbfop2,*)
70 c 0.4. ==> variables locales
72 integer larete, a1, a2, sm, s1, s2, m1, m2, nuv
73 c ______________________________________________________________________
78 c 1. interpolation pour les aretes qui viennent d'etre decoupees
81 do 10 , larete = 1, nbarto
83 cgn write(1,90001) 'Arete', larete, hetare(larete)
84 if ( hetare(larete).eq.2 ) then
86 c recuperation des aretes filles
91 c recuperation des sommets de l'arete
95 cgn write(1,90001) '. profil sommet 1', s1, profho(s1)
96 cgn write(1,90001) '. profil sommet 2', s2, profho(s2)
98 c recuperation du noeud milieu de l'arete
101 cgn write(1,90001) '. profil milieu', sm, profho(sm)
103 if ( profho(s1).eq.1 .and. profho(s2).eq.1 .and.
104 > profho(sm).eq.1 ) then
106 c recuperation des noeuds milieux des aretes filles
110 cgn write(1,90002) '. Noeuds milieux filles', m1, m2
114 c interpolation p2 a :
116 c interpolee (ui,i=1,3) = 3/8 u1 - 1/8 u2 + 3/4 u3
118 do 11, nuv = 1, nbfop2
120 vap2ho(nuv,m1) = trshu * vap2ho(nuv,s1)
121 > - unshu * vap2ho(nuv,s2)
122 > + trsqu * vap2ho(nuv,sm)
123 vap2ho(nuv,m2) = trshu * vap2ho(nuv,s2)
124 > - unshu * vap2ho(nuv,s1)
125 > + trsqu * vap2ho(nuv,sm)