src/tool/Utilitaire/utoraq.F

   1       subroutine utoraq ( somare, a1, a2, a3, a4,
   2      >                    or1, or2, or3, or4 )
   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 - ORientation des Aretes d'un Quadrangle
  24 c    --           --              -           -
  25 c Remarque : cela suppose que les aretes a1, a2, a3, a4 sont donnees
  26 c            dans l'ordre standard
  27 c Remarque : programme semblable a utsoqu
  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 . ori    .  s  . 1      . 1 ou -1 , selon que l'arete ari est dans   .
  35 c .        .     .        . le sens du quadrangle                      .
  36 c ______________________________________________________________________
  37 c
  38 c====
  39 c 0. declarations et dimensionnement
  40 c====
  41 c
  42 c 0.1. ==> generalites
  43 c
  44       implicit none
  45       save
  46 c
  47 c 0.2. ==> communs
  48 c
  49 c 0.3. ==> arguments
  50 c
  51       integer somare(2,*)
  52       integer a1, a2, a3, a4
  53       integer or1, or2, or3, or4
  54 c
  55 c 0.4. ==> variables locales
  56 c
  57 c====
  58 c 1. recherche des orientations :
  59 c    l'orientation de l'arete i est positive si son second somemt est
  60 c    un des sommets de l'arete i+1
  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(2,a1) .eq. somare(1,a2)  .or.
  74      >     somare(2,a1) .eq. somare(2,a2) ) then
  75 c          le 2nd noeud de l'arete 1 est un sommet de a2 ;
  76 c          donc l'orientation est positive
  77 c
  78         or1 = 1
  79 c
  80       else
  81 c
  82         or1 = -1
  83 c
  84       endif
  85 c
  86       if ( somare(2,a2) .eq. somare(1,a3)  .or.
  87      >     somare(2,a2) .eq. somare(2,a3) ) then
  88 c          le 2nd noeud de l'arete 2 est un sommet de a3 ;
  89 c          donc l'orientation est positive
  90 c
  91         or2 = 1
  92 c
  93       else
  94 c
  95         or2 = -1
  96 c
  97       endif
  98 c
  99       if ( somare(2,a3) .eq. somare(1,a4)  .or.
 100      >     somare(2,a3) .eq. somare(2,a4) ) then
 101 c          le 2nd noeud de l'arete 3 est un sommet de a4 ;
 102 c          donc l'orientation est positive
 103 c
 104         or3 = 1
 105 c
 106       else
 107 c
 108         or3 = -1
 109 c
 110       endif
 111 c
 112       if ( somare(2,a4) .eq. somare(1,a1)  .or.
 113      >     somare(2,a4) .eq. somare(2,a1) ) then
 114 c          le 2nd noeud de l'arete 4 est un sommet de a1 ;
 115 c          donc l'orientation est positive
 116 c
 117         or4 = 1
 118 c
 119       else
 120 c
 121         or4 = -1
 122 c
 123       endif
 124 c
 125       end