src/tool/Utilitaire/utdhex.F

   1       subroutine utdhex ( lehexa, diamet,
   2      >                    coonoe, somare, arequa,
   3      >                    quahex, coquhe, arehex )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c     UTilitaire : Diametre d'un HEXaedre
  25 c     --           -             ---
  26 c ______________________________________________________________________
  27 c
  28 c    Le diametre d'une maille est la longueur du plus grand segment que
  29 c    l'on peut tracer a l'interieur de cette maille.
  30 c    Pour un hexaedre, le diametre est le maximum des longueurs des
  31 c    aretes et des diagonales
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . lehexa . e   .  1     . numero du tetraedre a examiner             .
  37 c . diamet .  s  .  1     . qualite                                    .
  38 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  39 c .        .     . * sdim .                                            .
  40 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  41 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  42 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  43 c . coquhe . e   .nbhecf*6. codes des 6 quadrangles des hexaedres      .
  44 c . arehex . e   .nbheca12. numeros des 12 aretes des hexaedres        .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "nombno.h"
  59 #include "nombar.h"
  60 #include "nombqu.h"
  61 #include "nombhe.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       double precision diamet, coonoe(nbnoto,3)
  66 c
  67       integer lehexa
  68       integer somare(2,nbarto)
  69       integer arequa(nbquto,4)
  70       integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer s1, s2, s3, s4, s5, s6, s7,s8
  75 c
  76       integer listar(12), listso(8)
  77       integer iaux
  78 c
  79       double precision var(3)
  80       double precision ar1, ar2, ar3, ar4, ar5, ar6
  81       double precision ar7, ar8, ar9, ar10, ar11, ar12
  82       double precision ad1, ad2, ad3, ad4
  83 c
  84 c 0.5. ==> initialisations
  85 c
  86 c====
  87 c 1. les aretes et les sommets de l'hexaedre
  88 c====
  89 c
  90       call utashe ( lehexa,
  91      >              nbquto, nbhecf, nbheca,
  92      >              somare, arequa,
  93      >              quahex, coquhe, arehex,
  94      >              listar, listso )
  95 c
  96       s1 = listso(1)
  97       s2 = listso(2)
  98       s3 = listso(3)
  99       s4 = listso(4)
 100       s5 = listso(5)
 101       s6 = listso(6)
 102       s7 = listso(7)
 103       s8 = listso(8)
 104 c
 105 c====
 106 c 2. les carres des longueurs des 12 aretes et des 4 diagonales
 107 c====
 108 c
 109       var(1) = coonoe(s2,1) - coonoe(s1,1)
 110       var(2) = coonoe(s2,2) - coonoe(s1,2)
 111       var(3) = coonoe(s2,3) - coonoe(s1,3)
 112       ar1 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 113 c
 114       var(1) = coonoe(s4,1) - coonoe(s1,1)
 115       var(2) = coonoe(s4,2) - coonoe(s1,2)
 116       var(3) = coonoe(s4,3) - coonoe(s1,3)
 117       ar2 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 118 c
 119       var(1) = coonoe(s3,1) - coonoe(s2,1)
 120       var(2) = coonoe(s3,2) - coonoe(s2,2)
 121       var(3) = coonoe(s3,3) - coonoe(s2,3)
 122       ar3 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 123 c
 124       var(1) = coonoe(s4,1) - coonoe(s3,1)
 125       var(2) = coonoe(s4,2) - coonoe(s3,2)
 126       var(3) = coonoe(s4,3) - coonoe(s3,3)
 127       ar4 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 128 c
 129       var(1) = coonoe(s6,1) - coonoe(s1,1)
 130       var(2) = coonoe(s6,2) - coonoe(s1,2)
 131       var(3) = coonoe(s6,3) - coonoe(s1,3)
 132       ar5 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 133 c
 134       var(1) = coonoe(s5,1) - coonoe(s2,1)
 135       var(2) = coonoe(s5,2) - coonoe(s2,2)
 136       var(3) = coonoe(s5,3) - coonoe(s2,3)
 137       ar6 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 138 c
 139       var(1) = coonoe(s7,1) - coonoe(s4,1)
 140       var(2) = coonoe(s7,2) - coonoe(s4,2)
 141       var(3) = coonoe(s7,3) - coonoe(s4,3)
 142       ar7 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 143 c
 144       var(1) = coonoe(s8,1) - coonoe(s3,1)
 145       var(2) = coonoe(s8,2) - coonoe(s3,2)
 146       var(3) = coonoe(s8,3) - coonoe(s3,3)
 147       ar8 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 148 c
 149       var(1) = coonoe(s6,1) - coonoe(s5,1)
 150       var(2) = coonoe(s6,2) - coonoe(s5,2)
 151       var(3) = coonoe(s6,3) - coonoe(s5,3)
 152       ar9 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 153 c
 154       var(1) = coonoe(s7,1) - coonoe(s6,1)
 155       var(2) = coonoe(s7,2) - coonoe(s6,2)
 156       var(3) = coonoe(s7,3) - coonoe(s6,3)
 157       ar10 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 158 c
 159       var(1) = coonoe(s8,1) - coonoe(s5,1)
 160       var(2) = coonoe(s8,2) - coonoe(s5,2)
 161       var(3) = coonoe(s8,3) - coonoe(s5,3)
 162       ar11 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 163 c
 164       var(1) = coonoe(s8,1) - coonoe(s7,1)
 165       var(2) = coonoe(s8,2) - coonoe(s7,2)
 166       var(3) = coonoe(s8,3) - coonoe(s7,3)
 167       ar12 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 168 c
 169       var(1) = coonoe(s8,1) - coonoe(s1,1)
 170       var(2) = coonoe(s8,2) - coonoe(s1,2)
 171       var(3) = coonoe(s8,3) - coonoe(s1,3)
 172       ad1 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 173 c
 174       var(1) = coonoe(s7,1) - coonoe(s2,1)
 175       var(2) = coonoe(s7,2) - coonoe(s2,2)
 176       var(3) = coonoe(s7,3) - coonoe(s2,3)
 177       ad2 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 178 c
 179       var(1) = coonoe(s6,1) - coonoe(s3,1)
 180       var(2) = coonoe(s6,2) - coonoe(s3,2)
 181       var(3) = coonoe(s6,3) - coonoe(s3,3)
 182       ad3 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 183 c
 184       var(1) = coonoe(s4,1) - coonoe(s5,1)
 185       var(2) = coonoe(s4,2) - coonoe(s5,2)
 186       var(3) = coonoe(s4,3) - coonoe(s5,3)
 187       ad4 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 188 c
 189 c====
 190 c 3. diametre
 191 c    on ne prend la racine carre qu'ici pour economiser du temps calcul
 192 c====
 193 c
 194       diamet = max( ar1, ar2, ar3,  ar4,  ar5,  ar6,
 195      >              ar7, ar8, ar9, ar10, ar11, ar12,
 196      >              ad1, ad2, ad3, ad4 )
 197       diamet = sqrt(diamet)
 198 c
 199       end