src/tool/Utilitaire/utpmte.F

   1       subroutine utpmte ( letetr, prmixt,
   2      >                    coonoe, somare, aretri,
   3      >                    tritet, cotrte, aretet )
   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 : Produit Mixte d'un TEtraedre selon (12, 13, 14)
  25 c     --           -       -          --
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . letetr . e   .  1     . numero du tetraedre a examiner             .
  31 c . prmixt .  s  .  1     . produit mixte (12, 13, 14)                 .
  32 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  33 c .        .     . * sdim .                                            .
  34 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  35 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  36 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  37 c . cotrte . e   .nbtecf*4. code des 4 triangles des tetraedres        .
  38 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  39 c .____________________________________________________________________.
  40 c
  41 c====
  42 c 0. declarations et dimensionnement
  43 c====
  44 c
  45 c 0.1. ==> generalites
  46 c
  47       implicit none
  48       save
  49 c
  50 c 0.2. ==> communs
  51 c
  52 #include "nombno.h"
  53 #include "nombar.h"
  54 #include "nombtr.h"
  55 #include "nombte.h"
  56 c
  57 c 0.3. ==> arguments
  58 c
  59       double precision prmixt, coonoe(nbnoto,3)
  60 c
  61       integer letetr
  62       integer somare(2,nbarto)
  63       integer aretri(nbtrto,3)
  64       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
  65 c
  66 c 0.4. ==> variables locales
  67 c
  68       integer iaux
  69       integer listar(6)
  70       integer listso(4)
  71 c
  72       double precision v12(3), v13(3), v14(3)
  73 c
  74 c 0.5. ==> initialisations
  75 c ______________________________________________________________________
  76 c
  77 c====
  78 c 1. traitement
  79 c====
  80 c
  81 c 1.1. ==> les aretes et sommets de ce tetraedre
  82 c
  83       call utaste ( letetr,
  84      >              nbtrto, nbtecf, nbteca,
  85      >              somare, aretri,
  86      >              tritet, cotrte, aretet,
  87      >              listar, listso )
  88 c
  89 c 1.2. ==> memorisation des vecteurs lies aux aretes 12, 13, 14
  90 c
  91       v12(1) = coonoe(listso(2),1) - coonoe(listso(1),1)
  92       v12(2) = coonoe(listso(2),2) - coonoe(listso(1),2)
  93       v12(3) = coonoe(listso(2),3) - coonoe(listso(1),3)
  94 c
  95       v13(1) = coonoe(listso(3),1) - coonoe(listso(1),1)
  96       v13(2) = coonoe(listso(3),2) - coonoe(listso(1),2)
  97       v13(3) = coonoe(listso(3),3) - coonoe(listso(1),3)
  98 c
  99       v14(1) = coonoe(listso(4),1) - coonoe(listso(1),1)
 100       v14(2) = coonoe(listso(4),2) - coonoe(listso(1),2)
 101       v14(3) = coonoe(listso(4),3) - coonoe(listso(1),3)
 102 c
 103 c 1.3. ==> calcul du produit mixte (v12,v13,v14)
 104 c
 105       prmixt = ( v12(2)*v13(3) - v12(3)*v13(2) ) * v14(1)
 106      >       + ( v12(3)*v13(1) - v12(1)*v13(3) ) * v14(2)
 107      >       + ( v12(1)*v13(2) - v12(2)*v13(1) ) * v14(3)
 108 c
 109       end