1 subroutine utora3 ( orient,
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 UTilitaire - ORientation d'Aretes d'un paquet de 3
28 c Determine dans quel sens le paquet des aretes (a1,a2,a3) tourne
29 c relativement a l'arete a0
31 c Si a0 s'enfonce dans le plan courant :
43 c ______________________________________________________________________
45 c . nom . e/s . taille . description .
46 c .____________________________________________________________________.
47 c . orient . s . 1 . 1 : dans le sens positif .
48 c . . . . -1 : dans le sens negatif .
49 c . a0 . e . 1 . arete orientant .
50 c . a1-3 . e . 1 . aretes a placer .
51 c . coonoe . e .nbnoto*3. coordonnees des noeuds .
52 c . somare . es .2*nbarto. numeros des extremites d'arete .
53 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
54 c . langue . e . 1 . langue des messages .
55 c . . . . 1 : francais, 2 : anglais .
56 c . codret . es . 1 . code de retour des modules .
57 c . . . . 0 : pas de probleme .
58 c ______________________________________________________________________
61 c 0. declarations et dimensionnement
64 c 0.1. ==> generalites
70 parameter ( nompro = 'UTORA3' )
86 integer a0, a1, a2, a3
87 integer somare(2,nbarto)
89 double precision coonoe(nbnoto,sdim)
91 integer ulsort, langue, codret
93 c 0.4. ==> variables locales
98 double precision daux(3)
99 double precision v0(3), v1(3), v2(3), v3(3)
100 double precision prm1, prm2, prm3
103 parameter ( nbmess = 10 )
104 character*80 texte(nblang,nbmess)
106 c 0.5. ==> initialisations
115 #ifdef _DEBUG_HOMARD_
116 write (ulsort,texte(langue,1)) 'Entree', nompro
125 c 2. Arete definissant l'orientation
128 lenoeu = somare(1,a0)
129 do 21 , iaux = 1 , sdim
130 daux(iaux) = coonoe(lenoeu,iaux)
131 v0(iaux) = coonoe(somare(2,a0),iaux) - daux(iaux)
134 #ifdef _DEBUG_HOMARD_
136 write (ulsort,90001) 'origine arete orientante',a0,lenoeu
137 write (ulsort,90004) 'sommet origine ',(daux(iaux),iaux=1,sdim)
138 write (ulsort,90004) 'arete orientante',(v0(iaux),iaux=1,3)
143 c 3. Aretes a positionner
145 c 3.1. ==> vecteur de l'arete 1
147 if ( somare(1,a1).eq.lenoeu ) then
152 do 31 , iaux = 1 , sdim
153 v1(iaux) = coonoe(somare(jaux,a1),iaux) - daux(iaux)
156 c 3.2. ==> vecteur de l'arete 2
158 if ( somare(1,a2).eq.lenoeu ) then
163 do 32 , iaux = 1 , sdim
164 v2(iaux) = coonoe(somare(jaux,a2),iaux) - daux(iaux)
167 c 3.3. ==> vecteur de l'arete 3
169 if ( somare(1,a3).eq.lenoeu ) then
174 do 33 , iaux = 1 , sdim
175 v3(iaux) = coonoe(somare(jaux,a3),iaux) - daux(iaux)
178 #ifdef _DEBUG_HOMARD_
180 write (ulsort,90004) 'arete 1',(v1(iaux),iaux=1,3)
181 write (ulsort,90004) 'arete 2',(v2(iaux),iaux=1,3)
182 write (ulsort,90004) 'arete 3',(v3(iaux),iaux=1,3)
187 c 4. calcul des produits mixtes
188 c Si a0 s'enfonce dans le plan courant :
198 c Le produit mixte (a0,a1,a2) est >0 tant que a2 est "a droite" de a1,
199 c comme sur la figure. Il devient <0 quand a2 passe "a gauche".
200 c En examinant successivement les 3 produits, on en deduit la
201 c position relative de (a1,a2,a3)
204 call utprmi ( v0, v1, v2, prm1 )
205 call utprmi ( v0, v1, v3, prm2 )
206 call utprmi ( v0, v2, v3, prm3 )
207 #ifdef _DEBUG_HOMARD_
209 write (ulsort,90004) 'produits mixtes',prm1, prm2, prm3
213 if ( ( prm1.ge.0.d0 .and. prm2.le.0.d0 ) .or.
214 > ( prm1.ge.0.d0 .and. prm2.ge.0.d0 .and. prm3.ge.0.d0 ) .or.
215 > ( prm1.le.0.d0 .and. prm2.le.0.d0 .and. prm3.ge.0.d0 ) )
221 #ifdef _DEBUG_HOMARD_
223 write (ulsort,90002) 'orient',orient
231 if ( codret.ne.0 ) then
235 write (ulsort,texte(langue,1)) 'Sortie', nompro
236 write (ulsort,texte(langue,2)) codret
240 #ifdef _DEBUG_HOMARD_
241 write (ulsort,texte(langue,1)) 'Sortie', nompro