src/tool/Creation_Maillage/cmctea.F

   1       subroutine cmctea ( aretet, famtet,
   2      >                    hettet, filtet, pertet,
   3      >                    naret1, naret2, naret3, naret4,
   4      >                    naret5, naret6,
   5      >                    nupere, famill, nutetr )
   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 - Creation d'un TEtraedre par ses Aretes
  27 c    -           -          -             --                -
  28 c ______________________________________________________________________
  29 c
  30 c but : creation effective d'un tetraedre etant donne :
  31 c       - le numero du tetraedre
  32 c       - les numero globaux des aretes
  33 c       - le numero du pere
  34 c       - la famille a attribuer
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . aretet . es  .nouvta*6. numeros des 6 aretes des tetraedres        .
  40 c . famtet . es  . nouvte . famille des tetraedres                     .
  41 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  42 c . filtet . es  . nouvte . premier fils des tetraedres                .
  43 c . pertet . es  . nouvte . pere des tetraedres                        .
  44 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  45 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  46 c . nareti . e   . 1      . arete de numero local i dans le tetraedre  .
  47 c . nupere . e   . 1      . numero du pere du tetraedre                .
  48 c . famill . e   . 1      . famille a attribuer au tetraedre           .
  49 c . nutetr . e   . 1      . numero du tetraedre a creer                .
  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 "nouvnb.h"
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       integer aretet(nouvta,6), famtet(nouvte)
  68       integer hettet(nouvte), filtet(nouvte), pertet(nouvte)
  69       integer naret1, naret2, naret3, naret4
  70       integer naret5, naret6
  71       integer nupere, famill, nutetr
  72 c
  73 c 0.4. ==> variables locales
  74 c
  75       integer iaux
  76 c ______________________________________________________________________
  77 c
  78 c====
  79 c 1. creation effective d'un tetraedre
  80 c====
  81 c
  82 #ifdef _DEBUG_HOMARD_
  83 #include "impr03.h"
  84       write (1,90015) 'Tetraedre', nutetr,
  85      >                ', aretes', naret1, naret2, naret3, naret4,
  86      >                            naret5, naret6
  87 #endif
  88       iaux = nutetr - nouvtf
  89       aretet(iaux,1) = naret1
  90       aretet(iaux,2) = naret2
  91       aretet(iaux,3) = naret3
  92       aretet(iaux,4) = naret4
  93       aretet(iaux,5) = naret5
  94       aretet(iaux,6) = naret6
  95 c
  96       famtet(nutetr) = famill
  97 c
  98       hettet(nutetr) = 5500
  99       filtet(nutetr) = 0
 100       pertet(nutetr) = nupere
 101 c
 102       end