src/tool/Utilitaire/utpmhe.F

   1       subroutine utpmhe ( lehexa, prmixt,
   2      >                    som1, som2, som3, som4,
   3      >                    coonoe, somare, arequa,
   4      >                    quahex, coquhe, arehex )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c     UTilitaire : Produit Mixte d'un HExaedre
  26 c     --           -       -          --
  27 c         selon (som1-som2, som1-som3, som1-som4)
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . lehexa . e   .  1     . numero du tetraedre a examiner             .
  33 c . prmixt .  s  .  1     . produit mixte (12, 13, 14)                 .
  34 c . som i  . e   .  1     . sommets definissant le produit mixte       .
  35 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  36 c .        .     . * sdim .                                            .
  37 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  38 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  39 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  40 c . coquhe . e   .nbhecf*6. codes des 6 quadrangles des hexaedres      .
  41 c . arehex . e   .nbheca12. numeros des 12 aretes des hexaedres        .
  42 c .____________________________________________________________________.
  43 c
  44 c====
  45 c 0. declarations et dimensionnement
  46 c====
  47 c
  48 c 0.1. ==> generalites
  49 c
  50       implicit none
  51       save
  52 c
  53 c 0.2. ==> communs
  54 c
  55 #include "nombno.h"
  56 #include "nombar.h"
  57 #include "nombqu.h"
  58 #include "nombhe.h"
  59 c
  60 c 0.3. ==> arguments
  61 c
  62       double precision prmixt, coonoe(nbnoto,3)
  63 c
  64       integer lehexa
  65       integer som1, som2, som3, som4
  66       integer somare(2,nbarto)
  67       integer arequa(nbquto,4)
  68       integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
  69 c
  70 c 0.4. ==> variables locales
  71 c
  72       integer iaux
  73       integer listar(12)
  74       integer listso(8)
  75 c
  76       double precision v12(3), v13(3), v14(3)
  77 c
  78 c 0.5. ==> initialisations
  79 c ______________________________________________________________________
  80 c
  81 c====
  82 c 1. traitement
  83 c====
  84 c
  85 c 1.1. ==> les aretes et sommets de cet hexaedre
  86 c
  87       call utashe ( lehexa,
  88      >              nbquto, nbhecf, nbheca,
  89      >              somare, arequa,
  90      >              quahex, coquhe, arehex,
  91      >              listar, listso )
  92 c
  93 c 1.2. ==> memorisation des vecteurs lies
  94 c          aux aretes som1-som2, som1-som3, som1-som4
  95 c
  96       v12(1) = coonoe(listso(som2),1) - coonoe(listso(som1),1)
  97       v12(2) = coonoe(listso(som2),2) - coonoe(listso(som1),2)
  98       v12(3) = coonoe(listso(som2),3) - coonoe(listso(som1),3)
  99 c
 100       v13(1) = coonoe(listso(som3),1) - coonoe(listso(som1),1)
 101       v13(2) = coonoe(listso(som3),2) - coonoe(listso(som1),2)
 102       v13(3) = coonoe(listso(som3),3) - coonoe(listso(som1),3)
 103 c
 104       v14(1) = coonoe(listso(som4),1) - coonoe(listso(som1),1)
 105       v14(2) = coonoe(listso(som4),2) - coonoe(listso(som1),2)
 106       v14(3) = coonoe(listso(som4),3) - coonoe(listso(som1),3)
 107 c
 108 c 1.3. ==> calcul du produit mixte (v12,v13,v14)
 109 c
 110       prmixt = ( v12(2)*v13(3) - v12(3)*v13(2) ) * v14(1)
 111      >       + ( v12(3)*v13(1) - v12(1)*v13(3) ) * v14(2)
 112      >       + ( v12(1)*v13(2) - v12(2)*v13(1) ) * v14(3)
 113 c
 114       end