src/tool/Creation_Maillage/cmctet.F

   1       subroutine cmctet ( tritet, cotrte, famtet,
   2      >                    hettet, filtet, pertet,
   3      >                    ntria1, ntria2, ntria3, ntria4,
   4      >                    codef1, codef2, codef3, codef4,
   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
  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 faces locales 1, 2, 3 et 4
  33 c       - les codes des faces
  34 c       - le numero du pere
  35 c       - la famille a attribuer
  36 c       ce sous-programme est valable pour les tetraedres qui ne
  37 c       conservent aucune face de leur pere : tous sauf les tetraedres
  38 c       issus d'un decoupage en deux.
  39 c ______________________________________________________________________
  40 c .        .     .        .                                            .
  41 c .  nom   . e/s . taille .           description                      .
  42 c .____________________________________________________________________.
  43 c . tritet . es  .nouvtf*4. numeros des 4 triangles des tetraedres     .
  44 c . cotrte . es  .nouvtf*4. code des 4 triangles des tetraedres        .
  45 c . famtet . es  . nouvte . famille des tetraedres                     .
  46 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  47 c . filtet . es  . nouvte . premier fils des tetraedres                .
  48 c . pertet . es  . nouvte . pere des tetraedres                        .
  49 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  50 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  51 c . ntria1 . e   . 1      . face de numero local 1 dans le tetraedre   .
  52 c . ntria2 . e   . 1      . face de numero local 2 dans le tetraedre   .
  53 c . ntria3 . e   . 1      . face de numero local 3 dans le tetraedre   .
  54 c . ntria4 . e   . 1      . face de numero local 4 dans le tetraedre   .
  55 c . codef1 . e   . 1      . code de la face 1                          .
  56 c . codef2 . e   . 1      . code de la face 2                          .
  57 c . codef3 . e   . 1      . code de la face 3                          .
  58 c . codef4 . e   . 1      . code de la face 4                          .
  59 c . nupere . e   . 1      . numero du pere du tetraedre                .
  60 c . famill . e   . 1      . famille a attribuer au tetraedre           .
  61 c . nutetr . e   . 1      . numero du tetraedre a creer                .
  62 c ______________________________________________________________________
  63 c
  64 c====
  65 c 0. declarations et dimensionnement
  66 c====
  67 c
  68 c 0.1. ==> generalites
  69 c
  70       implicit none
  71       save
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "nouvnb.h"
  76 c
  77 c 0.3. ==> arguments
  78 c
  79       integer tritet(nouvtf,4), cotrte(nouvtf,4), famtet(nouvte)
  80       integer hettet(nouvte), filtet(nouvte), pertet(nouvte)
  81       integer ntria1, ntria2, ntria3, ntria4
  82       integer codef1, codef2, codef3, codef4
  83       integer nupere, famill, nutetr
  84 c
  85 c 0.4. ==> variables locales
  86 c
  87 c ______________________________________________________________________
  88 c
  89 c====
  90 c 1. creation effective d'un tetraedre
  91 c====
  92 c
  93 #ifdef _DEBUG_HOMARD_
  94 #include "impr03.h"
  95       write (1,90015) 'Tetraedre', nutetr,
  96      >                ', faces', ntria1, ntria2, ntria3, ntria4
  97       write (1,90015) 'Tetraedre', nutetr,
  98      >                ', codes', codef1, codef2, codef3, codef4
  99 #endif
 100       tritet(nutetr,1) = ntria1
 101       tritet(nutetr,2) = ntria2
 102       tritet(nutetr,3) = ntria3
 103       tritet(nutetr,4) = ntria4
 104 c
 105       cotrte(nutetr,1) = codef1
 106       cotrte(nutetr,2) = codef2
 107       cotrte(nutetr,3) = codef3
 108       cotrte(nutetr,4) = codef4
 109 c
 110       famtet(nutetr) = famill
 111 c
 112       hettet(nutetr) = 5500
 113       filtet(nutetr) = 0
 114       pertet(nutetr) = nupere
 115 c
 116       end