src/tool/Utilitaire/utnmpe.F

   1       subroutine utnmpe ( lepent, noeumi,
   2      >                    somare, aretri, arequa,
   3      >                    tritet, cotrte,
   4      >                    facpen, cofape, filpen, fppyte,
   5      >                    facpyr, cofapy )
   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 PEntaedre
  27 c    --           -     -           --
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . lepent . e   . 1      . numero du pentaedre 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 . facpen . e   .nbpecf*5. numeros des faces des pentaedres           .
  40 c . cofape . e   .nbpecf*5. codes des faces des pentaedres             .
  41 c . filpen . e   . nbpeto . premier fils des pentaedres                .
  42 c . fppyte . e   .  2**   . fppyte(1,j) = numero de la 1ere pyramide   .
  43 c .        .     .        . fille du pentaedre k tel que filpen(k) =-j .
  44 c .        .     .        . fppyte(2,j) = numero du 1er tetraedre      .
  45 c .        .     .        . fils du pentaedre k tel que filpen(k) = -j .
  46 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  47 c . cofapy . e   .nbpycf*5. codes des 5 faces des pyramides            .
  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 "nombtr.h"
  62 #include "nombqu.h"
  63 #include "nombte.h"
  64 #include "nombpy.h"
  65 #include "nombpe.h"
  66 c
  67 c 0.3. ==> arguments
  68 c
  69       integer lepent, noeumi
  70       integer somare(2,*)
  71       integer aretri(nbtrto,3)
  72       integer arequa(nbquto,4)
  73       integer tritet(nbtecf,4), cotrte(nbtecf,4)
  74       integer facpen(nbpecf,5), filpen(nbpeto)
  75       integer cofape(nbpecf,5), fppyte(2,nbpeco)
  76       integer facpyr(nbpycf,5), cofapy(nbpycf,5)
  77 c
  78 c 0.4. ==> variables locales
  79 c
  80       integer iaux
  81 c     f1hp = Fils 1er du pentaedre en numerotation Homard a l'it. N+1
  82       integer f1hp
  83       integer listar(9), listso(6)
  84 c
  85 c====
  86 c 1. Quand le pentaedre est decoupe par conformite pour trouver le noeud
  87 c    central, on est toujours dans un cas ou on a produit des tetraedres
  88 c    si le noeud central est un de leurs sommets, c'est S1.
  89 c    en prenant le 4eme tetraedre, on couvre tous les cas de figure
  90 c    Remarque : regarder cmcdpe pour ces conventions
  91 c====
  92 c
  93       f1hp = filpen(lepent)
  94 c
  95       iaux = fppyte(2,abs(f1hp)) + 3
  96 c
  97 c       les aretes et les sommets du 4eme tetraedre fils
  98 c
  99 cgn          print *,'==> tetraedre =',iaux
 100       call utarte ( iaux,
 101      >              nbtrto, nbtecf,
 102      >              aretri, tritet, cotrte,
 103      >              listar )
 104 c
 105       call utsote ( somare, listar, listso )
 106 c
 107 c     recuperation du noeud sommet central : le premier sommet
 108 c
 109       noeumi = listso(1)
 110 cgn          print *,'noeumi =',noeumi
 111 c
 112       end