src/tool/Utilitaire/utsope.F

   1       subroutine utsope ( somare, listar, sommet)
   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 PEntaedre
  23 c   --            --           --
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  29 c . listar . e   .    9   . Liste des aretes ordonnees suivant le penta.
  30 c . sommet .  s  .    *   . Liste des sommets ordonnes suivant le penta.
  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(9), sommet(*)
  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 1.1. ==> du cote de la face 1
  56 c
  57       iaux = somare(1,listar(1))
  58       if ( iaux.eq.somare(1,listar(2)) ) then
  59         sommet(1) = iaux
  60         sommet(2) = somare(2,listar(2))
  61         sommet(3) = somare(2,listar(1))
  62       elseif ( iaux.eq.somare(2,listar(2)) )then
  63         sommet(1) = iaux
  64         sommet(2) = somare(1,listar(2))
  65         sommet(3) = somare(2,listar(1))
  66       else
  67         sommet(1) = somare(2,listar(1))
  68         if ( sommet(1).eq.somare(1,listar(2)) ) then
  69           sommet(2) = somare(2,listar(2))
  70         else
  71           sommet(2) = somare(1,listar(2))
  72         endif
  73         sommet(3) = iaux
  74       endif
  75 c
  76 c 1.2. ==> du cote de la face 2
  77 c
  78       iaux = somare(1,listar(4))
  79       if ( iaux.eq.somare(1,listar(5)) ) then
  80         sommet(4) = iaux
  81         sommet(5) = somare(2,listar(5))
  82         sommet(6) = somare(2,listar(4))
  83       elseif ( iaux.eq.somare(2,listar(5)) )then
  84         sommet(4) = iaux
  85         sommet(5) = somare(1,listar(5))
  86         sommet(6) = somare(2,listar(4))
  87       else
  88         sommet(4) = somare(2,listar(4))
  89         if ( sommet(4).eq.somare(1,listar(5)) ) then
  90           sommet(5) = somare(2,listar(5))
  91         else
  92           sommet(5) = somare(1,listar(5))
  93         endif
  94         sommet(6) = iaux
  95       endif
  96 c
  97       end