src/tool/Utilitaire/utsopy.F

   1       subroutine utsopy ( 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'une PYramide
  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   .    8   . Liste des aretes ordonnees suivant la pyra .
  30 c . sommet .  s  .    5   . Liste des sommets ordonnes suivant la pyra .
  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(8), sommet(5)
  47 c
  48 c 0.4. ==> variables locales
  49 c
  50       integer iaux
  51 c
  52 c 0.5. ==> initialisations
  53 c ______________________________________________________________________
  54 c
  55 c                            S5
  56 c                            x
  57 c                         . . . .
  58 c                       .  .   .   .
  59 c                     .   .   a4.     .
  60 c                   .    .       .       .
  61 c                 .     .        x .         .
  62 c            a1 .      .     .   S4    .        .a3
  63 c             .       .  .                 .       .
  64 c           .        .                         .      .
  65 c         .      .  .                           a7 .     .
  66 c       .    .a8   .                                   .    .
  67 c     .  .        .                                        .   .
  68 c S1 .           .a2                                           .  .
  69 c  x .         .                                                  .  .
  70 c     a5  .    .                                                      .
  71 c             x--------------------------------------------------------x
  72 c           S2                            a6                          S3
  73 c   La face f5 est le quadrangle.
  74 c   La face fi, i<5, est le triangle s'appuyant sur l'arete ai.
  75 c
  76 c====
  77 c 1. Recherche des sommets
  78 c====
  79 c
  80       iaux = somare(1,listar(1))
  81       if ( iaux.eq.somare(1,listar(2)) ) then
  82         sommet(5) = iaux
  83         sommet(1) = somare(2,listar(1))
  84         sommet(2) = somare(2,listar(2))
  85       elseif ( iaux.eq.somare(2,listar(2)) )then
  86         sommet(5) = iaux
  87         sommet(1) = somare(2,listar(1))
  88         sommet(2) = somare(1,listar(2))
  89       else
  90         sommet(5) = somare(2,listar(1))
  91         sommet(1) = iaux
  92         if ( sommet(5).eq.somare(1,listar(2)) ) then
  93           sommet(2) = somare(2,listar(2))
  94         else
  95           sommet(2) = somare(1,listar(2))
  96         endif
  97       endif
  98 c
  99       iaux = somare(1,listar(6))
 100       if ( iaux.eq.sommet(2) ) then
 101         sommet(3) = somare(2,listar(6))
 102       else
 103         sommet(3) = iaux
 104       endif
 105 c
 106       iaux = somare(1,listar(7))
 107       if ( iaux.eq.sommet(3) ) then
 108         sommet(4) = somare(2,listar(7))
 109       else
 110         sommet(4) = iaux
 111       endif
 112 c
 113       end