1 subroutine pppma5 ( dedans, wn,
2 > nbnfa, vfa1, vfa2, vfa3, vfa4,
3 > nbnfb, vfb1, vfb2, vfb3, vfb4,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c Post-Processeur - Preparation du MAillage - phase 4
27 c ______________________________________________________________________
29 c On cherche a savoir si un point de la face B est dans la face A
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . dedans . s . 1 . vrai : un point de la face A est dans la .
36 c . . . . faux : aucun point commun .
37 c . wn . s . 2 . coordonnees du point inclus .
38 c . nbnfa . e . 1 . nombre de noeuds de la face A .
39 c . vfa1 . e . 3 . coordonnees du sommet 1 de la face A .
40 c . vfa2 . e . 3 . coordonnees du sommet 2 de la face A .
41 c . vfa3 . e . 3 . coordonnees du sommet 3 de la face A .
42 c . vfa4 . e . 3 . coordonnees du sommet 4 de la face A .
43 c . nbnfb . e . 1 . nombre de noeuds de la face B .
44 c . vfb1 . e . 3 . coordonnees du sommet 1 de la face B .
45 c . vfb2 . e . 3 . coordonnees du sommet 2 de la face B .
46 c . vfb3 . e . 3 . coordonnees du sommet 3 de la face B .
47 c . vfb4 . e . 3 . coordonnees du sommet 4 de la face B .
48 c . ulsort . e . 1 . unite logique de la sortie generale .
49 c . langue . e . 1 . langue des messages .
50 c . . . . 1 : francais, 2 : anglais .
51 c . codret . s . 1 . code de retour des modules .
52 c . . . . 0 : pas de probleme .
53 c ._____________________________________________________________________
56 c 0. declarations et dimensionnement
59 c 0.1. ==> generalites
65 parameter ( nompro = 'PPPMA5' )
79 double precision wn(2)
80 double precision vfa1(3), vfa2(3), vfa3(3), vfa4(3)
81 double precision vfb1(3), vfb2(3), vfb3(3), vfb4(3)
83 integer ulsort, langue, codret
85 c 0.4. ==> variables locales
88 parameter ( nbnx = 30 , nbny = 30 )
93 double precision daux1, daux2
96 parameter ( nbmess = 10 )
97 character*80 texte(nblang,nbmess)
99 c 0.5. ==> initialisations
101 c_______________________________________________________________________
109 #ifdef _DEBUG_HOMARD_
110 write (ulsort,texte(langue,1)) 'Entree', nompro
118 1796 format(a,6f12.5)
119 1797 format(i5,' *',6f12.5)
120 1798 format(i4,' :',i5,' *',3i4,' *',6f12.5)
121 1799 format(i4,' :',i5,' *',4i4,' *',6f12.5)
124 c 2. Un sommet de la face B est-il dans la face A?
127 do 21 , iaux = 1 , nbnfb
129 if ( iaux.eq.1 ) then
132 elseif ( iaux.eq.2 ) then
135 elseif ( iaux.eq.3 ) then
138 elseif ( iaux.eq.4 ) then
143 if ( nbnfa.eq.3 ) then
144 call uttrn2 ( dedans, vfa1, vfa2, vfa3, wn, typbor )
146 call utqun2 ( dedans, vfa1, vfa2, vfa3, vfa4, wn, typbor )
150 cgn print * ,'....... Le',iaux,'-eme sommet est dedans'
157 c 3. Un point interieur a la face B est-il dans la face A ?
158 c On cree des points par les methodes de maillages
159 c Evidemment il y a des trous, mais bon ...
161 c 3.1 ==> La face B est un triangle
163 if ( nbnfb.eq.3 ) then
166 do 31 , iaux = 1 , nbnx
168 daux1 = dble(iaux-1) / dble(nbnx-1)
169 if ( iaux.eq.1 .or. iaux.eq.nbnx ) then
175 do 311 , jaux = jdeb, jfin
177 daux2 = dble(jaux-1) / dble(nbny-1)
178 call uttfi1 ( daux1, daux2, vfb1, vfb2, vfb3, wn )
180 if ( nbnfa.eq.3 ) then
181 call uttrn2 ( dedans, vfa1, vfa2, vfa3, wn, typbor )
183 call utqun2 ( dedans, vfa1, vfa2, vfa3, vfa4, wn, typbor )
187 cgn print * ,'....... Un point interieur est dedans'
195 c 32. ==> La face B est un quadrangle
199 do 32 , iaux = 1 , nbnx
201 daux1 = dble(iaux-1) / dble(nbnx-1)
202 if ( iaux.eq.1 .or. iaux.eq.nbnx ) then
210 do 321 , jaux = jdeb, jfin
212 daux2 = dble(jaux-1) / dble(nbny-1)
213 call uttfi2 ( daux1, daux2, vfb1, vfb2, vfb3, vfb4, wn )
215 if ( nbnfa.eq.3 ) then
216 call uttrn2 ( dedans, vfa1, vfa2, vfa3, wn, typbor )
218 call utqun2 ( dedans, vfa1, vfa2, vfa3, vfa4, wn, typbor )
222 cgn print * ,'....... Un point interieur est dedans'
242 if ( codret.ne.0 ) then
246 write (ulsort,texte(langue,1)) 'Sortie', nompro
247 write (ulsort,texte(langue,2)) codret
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,1)) 'Sortie', nompro