src/tool/Creation_Maillage/cmchfe.F

   1       subroutine cmchfe ( indtet, indptp,
   2      >                    tritet, cotrte, famtet,
   3      >                    hettet, filtet, pertet,
   4      >                    trifad, cotrvo, triint, trigpy,
   5      >                    nufami )
   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    Creation du Maillage - Conformite - decoupage des Hexaedres
  27 c    -           -          -                          -
  28 c                         - par 1 Face - utilitaire E
  29 c                                 -                 -
  30 c ______________________________________________________________________
  31 c .        .     .        .                                            .
  32 c .  nom   . e/s . taille .           description                      .
  33 c .____________________________________________________________________.
  34 c . indtet . es  .   1    . indice du dernier tetraedre cree           .
  35 c . indptp . e   .   1    . indice du dernier pere enregistre          .
  36 c . tritet . es  .nouvtf*4. numeros des 4 triangles des tetraedres     .
  37 c . cotrte . es  .nouvtf*4. code des 4 triangles des tetraedres        .
  38 c . famtet . es  . nouvte . famille des tetraedres                     .
  39 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  40 c . filtet . es  . nouvte . premier fils des tetraedres                .
  41 c . pertet . es  . nouvte . pere des tetraedres                        .
  42 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  43 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  44 c . trifad . e   . (4,0:2). triangles sur les faces coupees en 3       .
  45 c . cotrvo . e   . (4,0:2). code de ces triangles dans les pyramides   .
  46 c . triint . e   .  (4,2) . triangles internes a l'hexaedre            .
  47 c . trigpy . e   .   4    . triangle de la grande pyramide             .
  48 c . nufami . e   . 1      . famille a attribuer au tetraedre           .
  49 c ______________________________________________________________________
  50 c
  51 c====
  52 c 0. declarations et dimensionnement
  53 c====
  54 c
  55 c 0.1. ==> generalites
  56 c
  57       implicit none
  58       save
  59 c
  60 cgn      character*6 nompro
  61 cgn      parameter ( nompro = 'CMCHFE' )
  62 c
  63 c 0.2. ==> communs
  64 c
  65 #include "nouvnb.h"
  66 c
  67 c 0.3. ==> arguments
  68 c
  69       integer indtet, indptp
  70       integer tritet(nouvtf,4), cotrte(nouvtf,4), famtet(nouvte)
  71       integer hettet(nouvte), filtet(nouvte), pertet(nouvte)
  72       integer trifad(4,0:2), cotrvo(4,0:2)
  73       integer triint(4,2)
  74       integer trigpy(4)
  75       integer nufami
  76 c
  77 c 0.4. ==> variables locales
  78 c
  79       integer iaux
  80 c
  81 c 0.5. ==> initialisations
  82 c ______________________________________________________________________
  83 c
  84 #ifdef _DEBUG_HOMARD_
  85       call dmflsh (iaux)
  86 #endif
  87 c
  88 c====
  89 c 2. les 4 tetraedres internes au decoupage selon une face d'hexaedre
  90 c    le tetraedre p est entre les pyramides p et p+1
  91 c====
  92 c
  93       iaux = -indptp
  94 c
  95       indtet = indtet + 1
  96       call cmctet ( tritet, cotrte, famtet,
  97      >              hettet, filtet, pertet,
  98      >              trifad(1,0), trigpy(1), triint(1,2), triint(1,1),
  99      >              cotrvo(1,0),         5,           1,           4,
 100      >              iaux, nufami, indtet )
 101 c
 102       indtet = indtet + 1
 103       call cmctet ( tritet, cotrte, famtet,
 104      >              hettet, filtet, pertet,
 105      >              trifad(2,0), trigpy(2), triint(2,2), triint(2,1),
 106      >              cotrvo(2,0),         5,           1,           4,
 107      >              iaux, nufami, indtet )
 108 c
 109       indtet = indtet + 1
 110       call cmctet ( tritet, cotrte, famtet,
 111      >              hettet, filtet, pertet,
 112      >              trifad(3,0), trigpy(3), triint(3,2), triint(3,1),
 113      >              cotrvo(3,0),         5,           1,           4,
 114      >              iaux, nufami, indtet )
 115 c
 116       indtet = indtet + 1
 117       call cmctet ( tritet, cotrte, famtet,
 118      >              hettet, filtet, pertet,
 119      >              trifad(4,0), trigpy(4), triint(4,2), triint(4,1),
 120      >              cotrvo(4,0),         5,           1,           4,
 121      >              iaux, nufami, indtet )
 122 c
 123 #ifdef _DEBUG_HOMARD_
 124       call dmflsh (iaux)
 125 #endif
 126 c
 127       end