src/tool/Utilitaire/utsoqu.F

   1       subroutine utsoqu ( somare, a1, a2, a3, a4,
   2      >                    sa1a2, sa2a3, sa3a4, sa4a1 )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c    UTilitaire - SOmmets d'un QUadrangle
  24 c    --           --           --
  25 c Remarque : cela suppose que les aretes a1, a2, a3, a4 soient donnees
  26 c            dans l'ordre standard
  27 c Remarque : programme semblable a utoraq
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . somare . e   .2*nbaret. numeros des extremites d'arete             .
  33 c .a1,..,a4. e   . 1      . les numeros d'aretes du quadrangle         .
  34 c . sa1a2  .  s  . 1      . sommet commun aux aretes a1 et a2          .
  35 c . sa2a3  .  s  . 1      . sommet commun aux aretes a2 et a3          .
  36 c . sa3a4  .  s  . 1      . sommet commun aux aretes a3 et a4          .
  37 c . sa4a1  .  s  . 1      . sommet commun aux aretes a4 et a1          .
  38 c ______________________________________________________________________
  39 c
  40 c====
  41 c 0. declarations et dimensionnement
  42 c====
  43 c
  44 c 0.1. ==> generalites
  45 c
  46       implicit none
  47       save
  48 c
  49 c 0.2. ==> communs
  50 c
  51 c 0.3. ==> arguments
  52 c
  53       integer somare(2,*)
  54       integer a1, a2, a3, a4
  55       integer sa1a2, sa2a3, sa3a4, sa4a1
  56 c
  57 c 0.4. ==> variables locales
  58 c
  59 c====
  60 c 1. recherche des sommets
  61 c====
  62 c
  63 c                      sa4a1   a4   sa3a4
  64 c                          ._________.
  65 c                          .         .
  66 c                          .         .
  67 c                        a1.         .a3
  68 c                          .         .
  69 c                          ._________.
  70 c                      sa1a2   a2   sa2a3
  71 c
  72 c
  73       if ( somare(1,a1).eq.somare(1,a2)  .or.
  74      >     somare(1,a1).eq.somare(2,a2) ) then
  75 c          le 1er noeud de l'arete 1 est un sommet de a2 ;
  76 c          donc le 2nd noeud de l'arete 1 est un sommet de a4
  77 c
  78         sa1a2 = somare(1,a1)
  79         sa4a1 = somare(2,a1)
  80 c
  81       else
  82 c               le 1er noeud de l'arete 1 n'est pas un sommet de a2 ;
  83 c               donc c'est qu'il est un des sommets de a4
  84 c               donc le 2nd noeud de l'arete 1 est un sommet de a2
  85         sa1a2 = somare(2,a1)
  86         sa4a1 = somare(1,a1)
  87 c
  88       endif
  89 c
  90       if ( somare(1,a3).eq.somare(1,a4)  .or.
  91      >     somare(1,a3).eq.somare(2,a4) ) then
  92 c               le 1er noeud de l'arete 3 est un sommet de a4 ;
  93 c               donc le 2nd noeud de l'arete 3 est un sommet de a2
  94         sa3a4 = somare(1,a3)
  95         sa2a3 = somare(2,a3)
  96 c
  97       else
  98 c               le 1er noeud de l'arete 3 n'est pas un sommet de a4 ;
  99 c               donc c'est qu'il est un des sommets de a2
 100 c               donc le 2nd noeud de l'arete 3 est un sommet de a4
 101         sa3a4 = somare(2,a3)
 102         sa2a3 = somare(1,a3)
 103 c
 104       endif
 105 c
 106       end