src/tool/Utilitaire/utdpyr.F

   1       subroutine utdpyr ( lapyra, diamet,
   2      >                    coonoe, somare, aretri,
   3      >                    facpyr, cofapy, arepyr )
   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'une PYRamide
  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 pyramide, le diametre est le maximum des longueurs des
  31 c    aretes et des diagonales de la base
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . lapyra . e   .  1     . numero de la pyramide 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 . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  42 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  43 c . cofapy . e   .nbpycf*5. codes des faces des pyramides              .
  44 c . arepyr . e   .nbpyca*8. numeros des 8 aretes des pyramides         .
  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 "nombtr.h"
  61 #include "nombpy.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       double precision diamet, coonoe(nbnoto,3)
  66 c
  67       integer lapyra
  68       integer somare(2,nbarto)
  69       integer aretri(nbtrto,3)
  70       integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer s1, s2, s3, s4, s5
  75 c
  76       integer listar(8), listso(5)
  77       integer iaux
  78 c
  79       double precision var(3)
  80       double precision ar1, ar2, ar3, ar4, ar5, ar6
  81       double precision ar7, ar8
  82       double precision ad1, ad2
  83 c
  84 c 0.5. ==> initialisations
  85 c
  86 c                            S5
  87 c                            x
  88 c                         . . . .
  89 c                       .  .   .   .
  90 c                     .   .   a4.     .
  91 c                   .    .       .       .
  92 c                 .     .        x .         .
  93 c            a1 .      .     .   S4    .        .a3
  94 c             .       .  .                 .       .
  95 c           .        .                         .      .
  96 c         .      .  .                           a7 .     .
  97 c       .    .a8   .                                   .    .
  98 c     .  .        .                                        .   .
  99 c S1 .           .a2                                           .  .
 100 c  x .         .                                                  .  .
 101 c     a5  .    .                                                      .
 102 c             x--------------------------------------------------------x
 103 c           S2                            a6                          S3
 104 c   La face f5 est le quadrangle.
 105 c   La face fi, i<5, est le triangle s'appuyant sur l'arete ai.
 106 c
 107 c====
 108 c 1. les aretes et les sommets de la pyramide
 109 c====
 110 c
 111       call utaspy ( lapyra,
 112      >              nbtrto, nbpycf, nbpyca,
 113      >              somare, aretri,
 114      >              facpyr, cofapy, arepyr,
 115      >              listar, listso )
 116 c
 117       s1 = listso(1)
 118       s2 = listso(2)
 119       s3 = listso(3)
 120       s4 = listso(4)
 121       s5 = listso(5)
 122 c
 123 c====
 124 c 2. les carres des longueurs des 8 aretes et des
 125 c    diagonales du quadrangle
 126 c====
 127 c
 128 c 2.1. ==> les aretes
 129 c
 130       var(1) = coonoe(s5,1) - coonoe(s1,1)
 131       var(2) = coonoe(s5,2) - coonoe(s1,2)
 132       var(3) = coonoe(s5,3) - coonoe(s1,3)
 133       ar1 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 134 c
 135       var(1) = coonoe(s5,1) - coonoe(s2,1)
 136       var(2) = coonoe(s5,2) - coonoe(s2,2)
 137       var(3) = coonoe(s5,3) - coonoe(s2,3)
 138       ar2 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 139 c
 140       var(1) = coonoe(s5,1) - coonoe(s3,1)
 141       var(2) = coonoe(s5,2) - coonoe(s3,2)
 142       var(3) = coonoe(s5,3) - coonoe(s3,3)
 143       ar3 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 144 c
 145       var(1) = coonoe(s5,1) - coonoe(s4,1)
 146       var(2) = coonoe(s5,2) - coonoe(s4,2)
 147       var(3) = coonoe(s5,3) - coonoe(s4,3)
 148       ar4 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 149 c
 150       var(1) = coonoe(s2,1) - coonoe(s1,1)
 151       var(2) = coonoe(s2,2) - coonoe(s1,2)
 152       var(3) = coonoe(s2,3) - coonoe(s1,3)
 153       ar5 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 154 c
 155       var(1) = coonoe(s3,1) - coonoe(s2,1)
 156       var(2) = coonoe(s3,2) - coonoe(s2,2)
 157       var(3) = coonoe(s3,3) - coonoe(s2,3)
 158       ar6 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 159 c
 160       var(1) = coonoe(s4,1) - coonoe(s3,1)
 161       var(2) = coonoe(s4,2) - coonoe(s3,2)
 162       var(3) = coonoe(s4,3) - coonoe(s3,3)
 163       ar7 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 164 c
 165       var(1) = coonoe(s1,1) - coonoe(s4,1)
 166       var(2) = coonoe(s1,2) - coonoe(s4,2)
 167       var(3) = coonoe(s1,3) - coonoe(s4,3)
 168       ar8 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 169 c
 170 c 2.2. ==> les diagonales de la base
 171 c
 172       var(1) = coonoe(s3,1) - coonoe(s1,1)
 173       var(2) = coonoe(s3,2) - coonoe(s1,2)
 174       var(3) = coonoe(s3,3) - coonoe(s1,3)
 175       ad1 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 176 c
 177       var(1) = coonoe(s4,1) - coonoe(s2,1)
 178       var(2) = coonoe(s4,2) - coonoe(s2,2)
 179       var(3) = coonoe(s4,3) - coonoe(s2,3)
 180       ad2 = var(1)*var(1) + var(2)*var(2) + var(3)*var(3)
 181 c
 182 c====
 183 c 3. diametre
 184 c    on ne prend la racine carre qu'ici pour economiser du temps calcul
 185 c====
 186 c
 187       diamet = max( ar1, ar2, ar3,  ar4,  ar5,  ar6,
 188      >              ar7, ar8, ad1, ad2 )
 189       diamet = sqrt(diamet)
 190 c
 191       end