src/tool/Utilitaire/utntet.F

   1       subroutine utntet ( letetr, niveau,
   2      >                    tritet, pertet, pthepe,
   3      >                    nivtri, nivqua,
   4      >                    quahex, facpen )
   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 : Niveau d'un TETraedre
  26 c     --           -           ---
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . letetr . e   .  1     . numero du tetraedre a examiner             .
  32 c . niveau .  s  .  1     . niveau                                     .
  33 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  34 c . pertet . e   . nbteto . pere des tetraedres                        .
  35 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  36 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  37 c . pthepe . e   .    *   . si i <= nbheco : numero de l'hexaedre      .
  38 c .        .     .        . si non : numero du pentaedre               .
  39 c . nivtri . e   . nbtrto . niveau dans le raffinement/deraffinement   .
  40 c . nivqua . e   . nbquto . niveau dans le raffinement/deraffinement   .
  41 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  42 c . facpen . e   .nbpecf*5. numeros des 5 faces des pentaedres         .
  43 c .____________________________________________________________________.
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "nombtr.h"
  57 #include "nombqu.h"
  58 #include "nombte.h"
  59 #include "nombhe.h"
  60 #include "nombpe.h"
  61 c
  62 c 0.3. ==> arguments
  63 c
  64       double precision niveau
  65 c
  66       integer letetr
  67       integer nivtri(nbtrto), nivqua(nbquto)
  68       integer tritet(nbtecf,4), pertet(nbteto), pthepe(*)
  69       integer quahex(nbhecf,6)
  70       integer facpen(nbpecf,5)
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer lafac1, lafac2, lafac3, lafac4, lafac5, lafac6
  75       integer lepere
  76       integer iaux, jaux
  77 c
  78 c 0.5. ==> initialisations
  79 c
  80 #include "impr03.h"
  81 c
  82 c====
  83 c 1. Determination du niveau
  84 c====
  85 c
  86 cgn      write(*,90002) 'nbtema, nbtecf, nbteto', nbtema, nbtecf, nbteto
  87 cgn      write(*,90002) 'letetr', letetr
  88 c
  89 c 1.1. ==> Du maillage initial
  90 c
  91       if ( letetr.le.nbtema ) then
  92 c
  93         niveau = 0.d0
  94 c
  95 c 1.2. ==> Au dela
  96 c
  97       else
  98 c
  99 c 1.2.1. ==> Si le tetraedre est decrit par faces :
 100 c            le plus haut niveau de ses faces
 101 c
 102         if ( letetr.le.nbtecf ) then
 103 c
 104           lafac1 = tritet(letetr,1)
 105           lafac2 = tritet(letetr,2)
 106           lafac3 = tritet(letetr,3)
 107           lafac4 = tritet(letetr,4)
 108           jaux = max(nivtri(lafac1),nivtri(lafac2),
 109      >               nivtri(lafac3),nivtri(lafac4))
 110 c
 111 c 1.2.2. ==> Si le tetraedre est decrit par aretes :
 112 c            son niveau est le niveau du pere augmente d'un cran
 113 c
 114         else
 115 c
 116           iaux = pertet(letetr)
 117           lepere = pthepe(-iaux)
 118 cgn      write(*,90002) 'iaux, lepere', iaux, lepere
 119 cgn      write(*,90002) 'nbheco', nbheco
 120 c
 121           if ( -iaux.le.nbheco ) then
 122 c
 123             lafac1 = quahex(lepere,1)
 124             lafac2 = quahex(lepere,2)
 125             lafac3 = quahex(lepere,3)
 126             lafac4 = quahex(lepere,4)
 127             lafac5 = quahex(lepere,5)
 128             lafac6 = quahex(lepere,6)
 129             jaux = max(nivqua(lafac1),nivqua(lafac2),nivqua(lafac3),
 130      >                 nivqua(lafac4),nivqua(lafac5),nivqua(lafac6))
 131           else
 132 c
 133             lafac1 = facpen(lepere,1)
 134             lafac2 = facpen(lepere,2)
 135             lafac3 = facpen(lepere,3)
 136             lafac4 = facpen(lepere,4)
 137             lafac5 = facpen(lepere,5)
 138             jaux = max(nivtri(lafac1),nivtri(lafac2),
 139      >                 nivqua(lafac3),nivqua(lafac4),nivqua(lafac5))
 140 c
 141           endif
 142 c
 143           jaux = jaux + 1
 144 c
 145         endif
 146 c
 147 cgn      write(*,90002) '==> jaux',jaux
 148         niveau = dble(jaux)
 149 c
 150 c 1.2.3. ==> Si le tetraedre est de conformite, on prend le niveau
 151 c            intermediaire immediatement inferieur
 152 c
 153         if ( letetr.gt.nbtepe ) then
 154           niveau = niveau - 0.5d0
 155         endif
 156 c
 157       endif
 158 cgn      write(*,90004) '==> niveau',niveau
 159 c
 160       end