src/tool/Utilitaire/utprma.F

   1       subroutine utprma ( sommet, arete1, arete2, arete3,
   2      >                    somare, nbnoto, coonoe,
   3      >                    promix, promin )
   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 - par Arete
  25 c   --           --      -           -
  26 c     effectue promix = A1.(A2^A3)
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . sommet . e   .   1    . sommet du triedre                          .
  32 c . arete1 . e   .   1    . premiere arete du triedre                  .
  33 c . arete2 . e   .   1    . premiere arete du triedre                  .
  34 c . arete3 . e   .   1    . premiere arete du triedre                  .
  35 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  36 c . nbnoto . e   .   1    . nombre de noeuds                           .
  37 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  38 c .        .     . * sdim .                                            .
  39 c . promix .  s  .   1    . le produit mixte brut                      .
  40 c . promin .  s  .   1    . le produit mixte des vecteurs normalises   .
  41 c .____________________________________________________________________.
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52 c 0.2. ==> communs
  53 c
  54 c 0.3. ==> arguments
  55 c
  56       integer sommet
  57       integer arete1, arete2, arete3
  58       integer nbnoto
  59       integer somare(2,*)
  60 c
  61       double precision coonoe(nbnoto,*)
  62       double precision promix, promin
  63 c
  64 c 0.4. ==> variables locales
  65 c
  66       integer iaux
  67       integer ideb, ifin
  68 c
  69       double precision daux, daux0
  70       double precision v1(3), v2(3), v3(3)
  71       double precision vn(3)
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 1. Les vecteurs des aretes
  76 c====
  77 c
  78       if ( somare(1,arete1).eq.sommet ) then
  79         ideb = 1
  80         ifin = 2
  81       else
  82         ideb = 2
  83         ifin = 1
  84       endif
  85 c
  86       daux0 = 0.d0
  87       do 11 , iaux = 1 , 3
  88         v1(iaux) = coonoe(somare(ifin,arete1),iaux)
  89      >           - coonoe(somare(ideb,arete1),iaux)
  90         daux0 = daux0 + v1(iaux)**2
  91    11 continue
  92       daux = sqrt(daux0)
  93 c
  94       if ( somare(1,arete2).eq.sommet ) then
  95         ideb = 1
  96         ifin = 2
  97       else
  98         ideb = 2
  99         ifin = 1
 100       endif
 101 c
 102       daux0 = 0.d0
 103       do 12 , iaux = 1 , 3
 104         v2(iaux) = coonoe(somare(ifin,arete2),iaux)
 105      >           - coonoe(somare(ideb,arete2),iaux)
 106         daux0 = daux0 + v2(iaux)**2
 107    12 continue
 108       daux = daux*sqrt(daux0)
 109 c
 110       if ( somare(1,arete3).eq.sommet ) then
 111         ideb = 1
 112         ifin = 2
 113       else
 114         ideb = 2
 115         ifin = 1
 116       endif
 117 c
 118       daux0 = 0.d0
 119       do 13 , iaux = 1 , 3
 120         v3(iaux) = coonoe(somare(ifin,arete3),iaux)
 121      >           - coonoe(somare(ideb,arete3),iaux)
 122         daux0 = daux0 + v3(iaux)**2
 123    13 continue
 124       daux = daux*sqrt(daux0)
 125 c
 126       vn(1) = v2(2)*v3(3) - v2(3)*v3(2)
 127       vn(2) = v2(3)*v3(1) - v2(1)*v3(3)
 128       vn(3) = v2(1)*v3(2) - v2(2)*v3(1)
 129 c
 130       promix = v1(1)*vn(1) + v1(2)*vn(2) + v1(3)*vn(3)
 131       promin = promix/daux
 132 c
 133       end