src/tool/Utilitaire/utqtr0.F

   1       subroutine utqtr0 ( qualit, surf, sdim, coonoe )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c     UTilitaire : Qualite d'un TRiangle - phase 0
  23 c     --           -            --               -
  24 c ______________________________________________________________________
  25 c
  26 c    on utilise le critere decrit dans
  27 c     'Maillages, applications aux elements finis'
  28 c     Pascal Jean Frey, Paul-Louis George
  29 c     Hermes, 1999
  30 c     Chapitre 18.2, page 606
  31 c                                           h
  32 c    le critere de qualite, q, vaut alpha * -
  33 c                                           r
  34 c    h est le diametre du triangle, i.e. son plus grand cote
  35 c    r est le rayon du cercle inscrit
  36 c    alpha est un coefficient de normalisation pour que le critere q
  37 c    vaille 1 pour un triangle equilateral ==> alpha = 1/racine(12)
  38 c
  39 c    pour tout autre triangle, le critere est donc superieur a 1
  40 c
  41 c                              max(ak) * somme des ak
  42 c    tous calculs faits q vaut ----------------------
  43 c                               racine(48) * surface
  44 c
  45 c    ou si est la surface du i-eme triangle,
  46 c       ak est la longueur du k-eme cote
  47 c       surface est la surface du triangle.
  48 c ______________________________________________________________________
  49 c .        .     .        .                                            .
  50 c .  nom   . e/s . taille .           description                      .
  51 c .____________________________________________________________________.
  52 c . qualit .  s  .  1     . qualite                                    .
  53 c . surf   .  s  .  1     . surface                                    .
  54 c . sdim   . e   .  1     . dimension du probleme                      .
  55 c . coonoe . e   . 3*sdim . coordonnees des 3 noeuds du triangle       .
  56 c .____________________________________________________________________.
  57 c
  58 c====
  59 c 0. declarations et dimensionnement
  60 c====
  61 c
  62 c 0.1. ==> generalites
  63 c
  64       implicit none
  65       save
  66 c
  67       character*6 nompro
  68       parameter ( nompro = 'UTQTR0' )
  69 c
  70 c 0.2. ==> communs
  71 c
  72 c 0.3. ==> arguments
  73 c
  74       integer sdim
  75       double precision qualit, surf, coonoe(3,sdim)
  76 c
  77 c 0.4. ==> variables locales
  78 c
  79       double precision ar1, ar2, ar3
  80       double precision v1(3), v2(3), v3(3)
  81       double precision alpha
  82 c
  83       logical prem
  84 c
  85 #include "fract0.h"
  86 #include "fracta.h"
  87 c
  88 c 0.5. ==> initialisations
  89 c
  90       data prem / .true. /
  91 c ______________________________________________________________________
  92 c
  93 c====
  94 c 1. le coefficient normalisateur
  95 c====
  96 c
  97       if ( prem ) then
  98         alpha = sqrt(unsdz)
  99         prem = .false.
 100       endif
 101 c
 102 c====
 103 c 2. les diverses longueurs et la surface
 104 c====
 105 c
 106 c 2.1. ==> en dimension 2
 107 c
 108       if ( sdim.eq.2 ) then
 109 c
 110 c 2.1.1. ==> calcul des longueurs des aretes
 111 c
 112         v1(1) = coonoe(2,1) - coonoe(1,1)
 113         v1(2) = coonoe(2,2) - coonoe(1,2)
 114         ar1 = sqrt ( v1(1)*v1(1) + v1(2)*v1(2) )
 115 c
 116         v2(1) = coonoe(3,1) - coonoe(2,1)
 117         v2(2) = coonoe(3,2) - coonoe(2,2)
 118         ar2 = sqrt ( v2(1)*v2(1) + v2(2)*v2(2) )
 119 c
 120         v3(1) = coonoe(1,1) - coonoe(3,1)
 121         v3(2) = coonoe(1,2) - coonoe(3,2)
 122         ar3 = sqrt ( v3(1)*v3(1) + v3(2)*v3(2) )
 123 c
 124 c 2.1.2. ==> calcul de la surface (plutot 2 fois la surface)
 125 c            on rappelle que la surface d'un triangle est egale
 126 c            a la moitie de la norme du produit vectoriel de deux
 127 c            des vecteurs representant les aretes.
 128 c
 129         surf = abs ( v1(1)*v3(2) - v1(2)*v3(1) )
 130 c
 131 c 2.2. ==> en dimension 3
 132 c
 133       else
 134 c
 135 c 2.2.1. ==> calcul des longueurs des aretes
 136 c
 137         v1(1) = coonoe(2,1) - coonoe(1,1)
 138         v1(2) = coonoe(2,2) - coonoe(1,2)
 139         v1(3) = coonoe(2,3) - coonoe(1,3)
 140         ar1 = sqrt ( v1(1)*v1(1) + v1(2)*v1(2) + v1(3)*v1(3) )
 141 c
 142         v2(1) = coonoe(3,1) - coonoe(2,1)
 143         v2(2) = coonoe(3,2) - coonoe(2,2)
 144         v2(3) = coonoe(3,3) - coonoe(2,3)
 145         ar2 = sqrt ( v2(1)*v2(1) + v2(2)*v2(2) + v2(3)*v2(3) )
 146 c
 147         v3(1) = coonoe(1,1) - coonoe(3,1)
 148         v3(2) = coonoe(1,2) - coonoe(3,2)
 149         v3(3) = coonoe(1,3) - coonoe(3,3)
 150         ar3 = sqrt ( v3(1)*v3(1) + v3(2)*v3(2) + v3(3)*v3(3) )
 151 c
 152 c 2.2.2. ==> calcul de la surface (plutot 2 fois la surface)
 153 c            on rappelle que la surface d'un triangle est egale
 154 c            a la moitie de la norme du produit vectoriel de deux
 155 c            des vecteurs representant les aretes.
 156 c
 157         v2(1) = v1(2)*v3(3) - v1(3)*v3(2)
 158         v2(2) = v1(3)*v3(1) - v1(1)*v3(3)
 159         v2(3) = v1(1)*v3(2) - v1(2)*v3(1)
 160         surf = sqrt ( v2(1)*v2(1) + v2(2)*v2(2) + v2(3)*v2(3) )
 161 c
 162       endif
 163 c
 164 c====
 165 c 3. qualite et surface
 166 c====
 167 c
 168       qualit = alpha * max(ar1,ar2,ar3) * (ar1+ar2+ar3) / surf
 169 c
 170       surf = unsde * surf
 171 c
 172       end