src/tool/Creation_Maillage/cmcte3.F

   1       subroutine cmcte3 ( lehexa, indtet, indptp,
   2      >                    laface, codfac, areint,
   3      >                    aretri, filqua,
   4      >                    aretet, famtet,
   5      >                    hettet, filtet, pertet,
   6      >                    famhex, cfahex,
   7      >                    ulsort, langue, codret )
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c    Creation du Maillage - Creation de TEtraedres par leurs aretes
  29 c    -           -          -           --
  30 c                         - par paquets de 3 appuyes sur une face
  31 c                                          -
  32 c ______________________________________________________________________
  33 c
  34 c       S1 si code<5     are1 si code<5          S4 si code<5
  35 c            |-----------------------------------|
  36 c            |   .----------------------->   .   |
  37 c            |  |                        .       |
  38 c            |  |   FFI+1            .         V |
  39 c            |  |                .             | |
  40 c            |  |            .                 | |
  41 c            |  |        .                     | |
  42 c            |       .                         | |
  43 c            |   .                             | |
  44 c         n1 .                   FFI           | |  are2
  45 c            |   .                             | |
  46 c            |       .                         | |
  47 c            |  |        .                     | |
  48 c            |  |            .                 | |
  49 c            |  |                .             | |
  50 c            |  |   FFI+2            .         V |
  51 c            |  |                        .       |
  52 c            |      <--------------------    .   |
  53 c            |-----------------------------------|
  54 c       S2 si code<5     are3 si code<5          S3 si code<5
  55 c ______________________________________________________________________
  56 c .        .     .        .                                            .
  57 c .  nom   . e/s . taille .           description                      .
  58 c .____________________________________________________________________.
  59 c . lehexa . e   .   1    . hexaedre a decouper                        .
  60 c . indtet . es  .   1    . indice du dernier tetraedre cree           .
  61 c . indptp . e   .   1    . indice du dernier pere enregistre          .
  62 c . laface . e   .   1    . face coupee en 3 triangles                 .
  63 c . codfac . e   .   1    . code de la face coupee en 3 tria dans l'hex.
  64 c . areint . e   .   5    . Les aretes internes utiles                 .
  65 c .        .     .        . S1 du cote ffi+1 S4 et S3 base ffi         .
  66 c .        .     .        . S2 du cote de ffi+2 n1 arete coupee        .
  67 c . aretri . e   .nouvtr*3. numeros des 3 aretes des triangles         .
  68 c . filqua . e   . nouvqu . premier fils des quadrangles               .
  69 c . aretet . es  .nouvta*6. numeros des 6 aretes des tetraedres        .
  70 c . famtet . es  . nouvte . famille des tetraedres                     .
  71 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  72 c . filtet . es  . nouvte . premier fils des tetraedres                .
  73 c . pertet . es  . nouvte . pere des tetraedres                        .
  74 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  75 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  76 c . famhex . e   . nouvhe . famille des hexaedres                      .
  77 c . cfahex .     . nctfhe. codes des familles des hexaedres            .
  78 c .        .     . nbfhex .   1 : famille MED                          .
  79 c .        .     .        .   2 : type d'hexaedres                     .
  80 c .        .     .        .   3 : famille des tetraedres de conformite .
  81 c .        .     .        .   4 : famille des pyramides de conformite  .
  82 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  83 c . langue . e   .    1   . langue des messages                        .
  84 c .        .     .        . 1 : francais, 2 : anglais                  .
  85 c . codret . es  .    1   . code de retour des modules                 .
  86 c ______________________________________________________________________
  87 c
  88 c====
  89 c 0. declarations et dimensionnement
  90 c====
  91 c
  92 c 0.1. ==> generalites
  93 c
  94       implicit none
  95       save
  96 c
  97       character*6 nompro
  98       parameter ( nompro = 'CMCTE3' )
  99 c
 100 #include "nblang.h"
 101 c
 102 c 0.2. ==> communs
 103 c
 104 #include "envex1.h"
 105 c
 106 #include "dicfen.h"
 107 #include "nbfami.h"
 108 #include "nouvnb.h"
 109 #include "coftfh.h"
 110 c
 111 c 0.3. ==> arguments
 112 c
 113       integer lehexa, indtet, indptp
 114       integer laface, codfac
 115       integer areint(5)
 116       integer aretri(nouvtr,3)
 117       integer filqua(nouvqu)
 118       integer hettet(nouvte), aretet(nouvta,6)
 119       integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
 120       integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
 121 c
 122       integer ulsort, langue, codret
 123 c
 124 c 0.4. ==> variables locales
 125 c
 126       integer iaux
 127       integer nupere, nufami
 128       integer as1n1, as4n1, as3n1, as2n1
 129       integer as1s0, as4s0, as3s0, as2s0, an1s0
 130       integer as1s4, as2s3, as3s4
 131 c
 132       integer nbmess
 133       parameter ( nbmess = 10 )
 134       character*80 texte(nblang,nbmess)
 135
 136 c ______________________________________________________________________
 137 c
 138 c====
 139 c 1. initialisations
 140 c====
 141 c
 142 #include "impr01.h"
 143 c
 144 #ifdef _DEBUG_HOMARD_
 145       write (ulsort,texte(langue,1)) 'Entree', nompro
 146       call dmflsh (iaux)
 147 #endif
 148 c
 149 #include "impr03.h"
 150 c
 151       codret = 0
 152 c
 153 #ifdef _DEBUG_HOMARD_
 154       write (ulsort,90002) 'laface, codfac', laface, codfac
 155       write (ulsort,90002) 'areint', areint
 156 #endif
 157 c
 158 c====
 159 c 2. Recuperation des aretes tracees sur la face et des aretes internes
 160 c====
 161 c
 162       iaux = -filqua(laface)
 163 c
 164       if ( codfac.lt.5 ) then
 165         as4n1 = aretri(iaux,1)
 166         as3n1 = aretri(iaux,3)
 167         as1n1 = aretri(iaux+1,1)
 168         as1s4 = aretri(iaux+1,2)
 169         as2n1 = aretri(iaux+2,1)
 170         as2s3 = aretri(iaux+2,3)
 171       else
 172         as4n1 = aretri(iaux,3)
 173         as3n1 = aretri(iaux,1)
 174         as1n1 = aretri(iaux+2,1)
 175         as1s4 = aretri(iaux+2,3)
 176         as2n1 = aretri(iaux+1,1)
 177         as2s3 = aretri(iaux+1,2)
 178       endif
 179       as3s4 = aretri(iaux,2)
 180       as1s0 = areint(1)
 181       as4s0 = areint(2)
 182       as3s0 = areint(3)
 183       as2s0 = areint(4)
 184       an1s0 = areint(5)
 185 c
 186 #ifdef _DEBUG_HOMARD_
 187       write (ulsort,90002) 'as1n1, as4n1, as3n1, as2n1',
 188      >                      as1n1, as4n1, as3n1, as2n1
 189       write (ulsort,90002) 'as1s0, as4s0, as3s0, as2s0, an1s0',
 190      >                      as1s0, as4s0, as3s0, as2s0, an1s0
 191       write (ulsort,90002) 'as1s4, as2s3, as3s4',
 192      >                      as1s4, as2s3, as3s4
 193 #endif
 194 c
 195 c====
 196 c 3. Creation des tetraedres
 197 c====
 198 c
 199       nupere = -indptp
 200       nufami = cfahex(coftfh,famhex(lehexa))
 201 c
 202 c 3.1. ==> Sur la face centrale, ffi
 203 c
 204       indtet = indtet + 1
 205 #ifdef _DEBUG_HOMARD_
 206       write (ulsort,texte(langue,3)) 'CMCTEA pour ffi', nompro
 207 #endif
 208       call cmctea ( aretet, famtet, hettet, filtet, pertet,
 209      >              an1s0, as4s0, as3s0, as4n1,
 210      >              as3n1, as3s4,
 211      >              nupere, nufami, indtet )
 212 c
 213 c 3.2. ==> Sur la face ffi+1 (si code<5)
 214 c
 215       indtet = indtet + 1
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,texte(langue,3)) 'CMCTEA pour ffi+1', nompro
 218 #endif
 219       call cmctea ( aretet, famtet, hettet, filtet, pertet,
 220      >              an1s0, as1s0, as4s0, as1n1,
 221      >              as4n1, as1s4,
 222      >              nupere, nufami, indtet )
 223 c
 224 c 3.3. ==> Sur la face ffi+2 (si code<5)
 225 c
 226       indtet = indtet + 1
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,texte(langue,3)) 'CMCTEA pour ffi+2', nompro
 229 #endif
 230       call cmctea ( aretet, famtet, hettet, filtet, pertet,
 231      >              an1s0, as3s0, as2s0, as3n1,
 232      >              as2n1, as2s3,
 233      >              nupere, nufami, indtet )
 234 c
 235 c====
 236 c 4. la fin
 237 c====
 238 c
 239       if ( codret.ne.0 ) then
 240 c
 241 #include "envex2.h"
 242 c
 243       write (ulsort,texte(langue,1)) 'Sortie', nompro
 244       write (ulsort,texte(langue,2)) codret
 245 c
 246       endif
 247 c
 248 #ifdef _DEBUG_HOMARD_
 249       write (ulsort,texte(langue,1)) 'Sortie', nompro
 250       call dmflsh (iaux)
 251 #endif
 252 c
 253       end