src/tool/Utilitaire/utqco2.F

   1       subroutine utqco2 ( qual, coonoe,
   2      >                    are, somare, facare, posifa,
   3      >                    aretri, voltri,
   4      >                    tritet, cotrte, aretet, filtet, hettet )
   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 but : calcul de la qualite d'une coquille autour d'une arete qui vient
  26 c     d'etre decoupee (on suppose donc que les tetraedres sont peres ou
  27 c     grand-peres)
  28 c ______________________________________________________________________
  29 c
  30 c   UTilitaire : Qualite d'une COquille (descendants d'ordre 2 au plus)
  31 c   --           -             --                            -
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . coonoe . e   .nbnoto*3. coordonnees des noeuds                     .
  37 c .   are  . e   .   1    . numero de l'arete d'enroulement            .
  38 c . somare . es  .2*nbarto. numeros des extremites d'arete             .
  39 c . facare . es  . nbfaar . liste des faces contenant une arete        .
  40 c . posifa . e   . nbarto . pointeur sur tableau facare                .
  41 c . aretri . es  .nbtrto*3. numeros des 3 aretes des triangles         .
  42 c . voltri . e   .2*nbtrto. numeros des 2 tetraedres des faces         .
  43 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  44 c . cotrte . e   .nbtecf*4. code des 4 triangles des tetraedres        .
  45 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  46 c . filtet . e   . nbteto . premier fils des tetraedres                .
  47 c . hettet . e   . nbtrto . historique de l'etat des tetraedres        .
  48 c ______________________________________________________________________
  49 c
  50 c====
  51 c 0. declarations et dimensionnement
  52 c====
  53 c
  54 c 0.1. ==> generalites
  55 c
  56       implicit none
  57       save
  58 c
  59 c 0.2. ==> communs
  60 c
  61 #include "nombno.h"
  62 #include "nombar.h"
  63 #include "nombtr.h"
  64 #include "nombte.h"
  65 c
  66 c 0.3. ==> arguments
  67 c
  68       double precision coonoe(nbnoto,3)
  69 c
  70       integer are
  71       integer somare(2,nbarto), posifa(0:nbarto), facare(nbfaar)
  72       integer aretri(nbtrto,3), voltri(2,nbtrto)
  73       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
  74       integer filtet(nbteto), hettet(nbteto)
  75 c
  76 c 0.4. ==> variables locales
  77 c
  78       integer etat
  79       integer ifa, fac
  80       integer nfils, ifils, nfil2, ifil2
  81       integer ite, tet, te2, tef
  82 c
  83       double precision qual, qualte
  84       double precision daux, daux0
  85 c
  86 c 0.5. ==> initialisations
  87 c ______________________________________________________________________
  88 c
  89       qual = 0.d0
  90 c
  91 c     boucle sur les faces de la coquille
  92 c
  93       do 1 , ifa=posifa(are-1)+1,posifa(are)
  94 c
  95          fac = facare(ifa)
  96 c
  97 c        recuperation des 2 tetraedres
  98 c
  99          do 11 , ite=1,2
 100 c
 101             tet = voltri(ite,fac)
 102 c
 103             if (tet.gt.0) then
 104 c
 105                if (filtet(tet).gt.0) then
 106 c
 107 c                 premier passage (sur 2)
 108 c
 109                   etat = mod(hettet(tet),100)
 110                   if (etat.lt.30) then
 111                      nfils = 2
 112                   elseif (etat.lt.50) then
 113                      nfils = 4
 114                   elseif (etat.lt.60) then
 115                      nfils = 0
 116                   else
 117                      nfils = 8
 118                   endif
 119 c
 120 c                 qualite des descendants
 121 c
 122                   do 111 , ifils=1,nfils
 123 c
 124                      tef = filtet(tet)+ifils-1
 125 c
 126                      if (filtet(tef).eq.0) then
 127 c
 128 c                       si le fils est actif : sa qualite
 129 c
 130                         call utqtet ( tef, qualte, daux0, daux,
 131      >                                coonoe, somare, aretri,
 132      >                                tritet, cotrte, aretet )
 133                         qual = max ( qual, qualte )
 134                      else
 135 c
 136 c                       si le fils est inactif : petits-fils
 137 c
 138                         etat = mod(hettet(tef),100)
 139                         if (etat.lt.30) then
 140                            nfil2 = 2
 141                         elseif (etat.lt.50) then
 142                            nfil2 = 4
 143                         elseif (etat.lt.60) then
 144                            nfil2 = 0
 145                         else
 146                            nfil2 = 8
 147                         endif
 148                         do 1111 , ifil2=1,nfil2
 149                           te2 = filtet(tef)+ifil2-1
 150                           call utqtet ( te2, qualte, daux0, daux,
 151      >                                  coonoe, somare, aretri,
 152      >                                  tritet, cotrte, aretet )
 153                         qual = max ( qual, qualte )
 154                           qual = max ( qual, qualte )
 155  1111                   continue
 156                      endif
 157 c
 158   111             continue
 159 c
 160                endif
 161 c
 162                filtet(tet) = -filtet(tet)
 163 c
 164             endif
 165 c
 166    11    continue
 167 c
 168     1 continue
 169 c
 170       end