1 subroutine utsote ( somare, listar, listso )
2 c ______________________________________________________________________
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
9 c aupres des huissiers de justice Simart et Lavoir a Clamart
10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
11 c aupres des huissiers de justice
12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
14 c HOMARD est une marque deposee d'Electricite de France
20 c ______________________________________________________________________
22 c UTilitaire - SOmmets d'un TEtraedre
24 c ______________________________________________________________________
26 c . nom . e/s . taille . description .
27 c .____________________________________________________________________.
28 c . somare . e .2*nbaret. numeros des extremites d'arete .
29 c . listar . e . 6 . Liste des aretes ordonnees suivant le tetr .
30 c . listso . s . 4 . Liste des sommets ordonnes suivant le tetr .
31 c ______________________________________________________________________
34 c 0. declarations et dimensionnement
37 c 0.1. ==> generalites
46 integer somare(2,*), listar(6), listso(4)
48 c 0.4. ==> variables locales
53 c 1. recherche des sommets
55 c la face fi est opposee au sommet ni
69 c *..................................*
72 iaux = somare(1,listar(1))
73 if ( iaux.eq.somare(1,listar(2)) ) then
76 listso(2) = somare(2,listar(1))
77 listso(3) = somare(2,listar(2))
79 elseif ( iaux.eq.somare(2,listar(2)) ) then
82 listso(2) = somare(2,listar(1))
83 listso(3) = somare(1,listar(2))
85 elseif ( somare(2,listar(1)).eq.somare(1,listar(2)) ) then
87 listso(1) = somare(2,listar(1))
89 listso(3) = somare(2,listar(2))
93 listso(1) = somare(2,listar(1))
95 listso(3) = somare(1,listar(2))
99 if ( somare(1,listar(6)).eq.somare(1,listar(3)) .or.
100 > somare(1,listar(6)).eq.somare(2,listar(3)) ) then
102 listso(4) = somare(1,listar(6))
106 listso(4) = somare(2,listar(6))