src/tool/Utilitaire/utsote.F

   1       subroutine utsote ( somare, listar, listso )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   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
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c    UTilitaire - SOmmets d'un TEtraedre
  23 c    --           --           --
  24 c ______________________________________________________________________
  25 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 ______________________________________________________________________
  32 c
  33 c====
  34 c 0. declarations et dimensionnement
  35 c====
  36 c
  37 c 0.1. ==> generalites
  38 c
  39       implicit none
  40       save
  41 c
  42 c 0.2. ==> communs
  43 c
  44 c 0.3. ==> arguments
  45 c
  46       integer somare(2,*), listar(6), listso(4)
  47 c
  48 c 0.4. ==> variables locales
  49 c
  50       integer iaux
  51 c
  52 c====
  53 c 1. recherche des sommets
  54 c====
  55 c                                    la face fi est opposee au sommet ni
  56 c                     n1
  57 c                     *
  58 c                    .  ..
  59 c                   .     . . a3
  60 c                  .        .  .
  61 c                 .           .   .
  62 c             a1 .          a2  .    .  n4
  63 c               .                 .    *
  64 c              .                  . .   .
  65 c             .        a5    .        .  . a6
  66 c            .          .               . .
  67 c           .      .                      ..
  68 c          .  .                             .
  69 c         *..................................*
  70 c       n2               a4                  n3
  71 c
  72       iaux = somare(1,listar(1))
  73       if ( iaux.eq.somare(1,listar(2)) ) then
  74 c
  75         listso(1) = iaux
  76         listso(2) = somare(2,listar(1))
  77         listso(3) = somare(2,listar(2))
  78 c
  79       elseif ( iaux.eq.somare(2,listar(2)) ) then
  80 c
  81         listso(1) = iaux
  82         listso(2) = somare(2,listar(1))
  83         listso(3) = somare(1,listar(2))
  84 c
  85       elseif ( somare(2,listar(1)).eq.somare(1,listar(2)) ) then
  86 c
  87         listso(1) = somare(2,listar(1))
  88         listso(2) = iaux
  89         listso(3) = somare(2,listar(2))
  90 c
  91       else
  92 c
  93         listso(1) = somare(2,listar(1))
  94         listso(2) = iaux
  95         listso(3) = somare(1,listar(2))
  96 c
  97       endif
  98 c
  99       if ( somare(1,listar(6)).eq.somare(1,listar(3)) .or.
 100      >     somare(1,listar(6)).eq.somare(2,listar(3)) ) then
 101 c
 102         listso(4) = somare(1,listar(6))
 103 c
 104       else
 105 c
 106         listso(4) = somare(2,listar(6))
 107 c
 108       endif
 109 c
 110       end