src/tool/Utilitaire/utnhex.F

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