src/tool/Utilitaire/utnmhe.F

   1       subroutine utnmhe ( lehexa, noeumi,
   2      >                    somare, aretri, arequa,
   3      >                    tritet, cotrte, aretet,
   4      >                    quahex, coquhe, filhex, fhpyte,
   5      >                    facpyr, cofapy, arepyr )
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c    UTilitaire - Noeud Milieu d'un HExaedre
  27 c    --           -     -           --
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . lehexa . e   . 1      . numero de l'hexaedre a examiner            .
  33 c . noeumi .  s  . 1      . numero du noeud milieu                     .
  34 c . somare . e   .2*nbaret. numeros des extremites d'arete             .
  35 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  36 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  37 c . tritet . e   .nbtecf*4. numeros des triangles des tetraedres       .
  38 c . cotrte . e   .nbtecf*4. codes des triangles des tetraedres         .
  39 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  40 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  41 c . coquhe . e   .nbhecf*6. codes des 6 quadrangles des hexaedres      .
  42 c . filhex . e   . nbheto . premier fils des hexaedres                 .
  43 c . fhpyte . e   .2*nbheco. fhpyte(1,j) = numero de la 1ere pyramide   .
  44 c .        .     .        . fille de l'hexaedre k tel que filhex(k) =-j.
  45 c .        .     .        . fhpyte(2,j) = numero du 1er tetraedre      .
  46 c .        .     .        . fils de l'hexaedre k tel que filhex(k) = -j.
  47 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  48 c . cofapy . e   .nbpycf*5. codes des 5 faces des pyramides            .
  49 c . arepyr . e   .nbpyca*8. numeros des 8 aretes des pyramides         .
  50 c ______________________________________________________________________
  51 c
  52 c====
  53 c 0. declarations et dimensionnement
  54 c====
  55 c
  56 c 0.1. ==> generalites
  57 c
  58       implicit none
  59       save
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "nombtr.h"
  64 #include "nombqu.h"
  65 #include "nombte.h"
  66 #include "nombpy.h"
  67 #include "nombhe.h"
  68 c
  69 c 0.3. ==> arguments
  70 c
  71       integer lehexa, noeumi
  72       integer somare(2,*)
  73       integer aretri(nbtrto,3)
  74       integer arequa(nbquto,4)
  75       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
  76       integer quahex(nbhecf,6), filhex(nbheto)
  77       integer coquhe(nbhecf,6), fhpyte(2,nbheco)
  78       integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
  79 c
  80 c 0.4. ==> variables locales
  81 c
  82       integer iaux, jaux
  83 c     f1hp = Fils 1er de l'hexaedre en numerotation Homard a l'it. N+1
  84       integer f1hp
  85       integer listar(12), listso(8)
  86 c
  87 c====
  88 c 1. Le fils enregistre.
  89 c    Si positif, c'est un decoupage standard en 8 hexaedres
  90 c    Si negatif, c'est un decoupage de conformite en pyramides et
  91 c    tetraedres.
  92 c====
  93 c
  94       f1hp = filhex(lehexa)
  95 cgn      print *,'f1hp =',f1hp
  96 cgn      print *,fhpyte(1,1),fhpyte(2,1)
  97 c
  98 c====
  99 c 2. Quand l'hexaedre est decoupe en 8 : pour trouver le noeud central,
 100 c    on examine le premier fils de l'hexaedre.
 101 c    Remarque : regarder cmrdhe pour ces conventions
 102 c====
 103 c
 104       if ( f1hp.gt.0) then
 105 c
 106 c       les aretes et les sommets de l'hexaedre fils
 107 c
 108         call utarhe ( f1hp,
 109      >                nbquto, nbhecf,
 110      >                arequa, quahex, coquhe,
 111      >                listar )
 112 c
 113         call utsohe ( somare, listar, listso )
 114 c
 115 c     recuperation du noeud sommet central : le huitieme sommet
 116 c
 117         noeumi = listso(8)
 118 c
 119 c====
 120 c 3. Quand l'hexaedre est decoupe par conformite pour trouver le noeud
 121 c    central, on examine le premier fils de l'hexaedre, pyramide ou
 122 c    tetraedre
 123 c    Remarque : regarder cmcdhe pour ces conventions
 124 c====
 125 c
 126       else
 127 c
 128         iaux = fhpyte(1,abs(f1hp))
 129 cgn          print *,'iaux =',iaux
 130 c
 131 c 3.1. ==> On a au moins une pyramide
 132 c
 133         if ( iaux.ne.0 ) then
 134 c
 135 c       les aretes et les sommets de la 1ere pyramide fils
 136 c
 137 cgn          print *,'==> pyramide =',iaux
 138           call utaspy ( iaux,
 139      >                  nbtrto, nbpycf, nbpyca,
 140      >                  somare, aretri,
 141      >                  facpyr, cofapy, arepyr,
 142      >                  listar, listso )
 143 c
 144 c     recuperation du noeud sommet central : le cinquieme sommet
 145 c
 146           noeumi = listso(5)
 147 c
 148 c 3.2. ==> Il n'y a que des tetraedres
 149 c
 150         else
 151 c
 152           iaux = fhpyte(2,abs(f1hp))
 153 c
 154 c       les aretes et les sommets du 1er tetraedre fils
 155 c
 156 cgn          print *,'==> tetraedre =',iaux
 157           call utaste ( iaux,
 158      >                  nbtrto, nbtecf, nbteca,
 159      >                  somare, aretri,
 160      >                  tritet, cotrte, aretet,
 161      >                  listar, listso )
 162 c
 163 c     recuperation du noeud sommet central : le premier sommet
 164 c
 165           noeumi = listso(1)
 166 c
 167         endif
 168 c
 169       endif
 170 cgn          print *,'noeumi =',noeumi
 171 c
 172       end