src/tool/Creation_Maillage/cmchai.F

   1       subroutine cmchai ( lehexa, indtet, indptp, tcod,
   2      >                    trifad, cotrvo, triint,
   3      >                    hettet, tritet, cotrte,
   4      >                    filtet, pertet, famtet,
   5      >                    famhex, cfahex,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c    Creation du Maillage - Conformite - decoupage des Hexaedres
  28 c    -           -          -                          -
  29 c                         - par 2 Aretes non en vis-a-vis - phase I
  30 c                                 -                               -
  31 c    Remarque : cmchae, cmchag, cmchai, cmchan et cmcham sont des clones
  32 c               cmchan et cmcham sont symetriques
  33 c ______________________________________________________________________
  34 c .        .     .        .                                            .
  35 c .  nom   . e/s . taille .           description                      .
  36 c .____________________________________________________________________.
  37 c . lehexa . e   .   1    . hexaedre a decouper                        .
  38 c . indtet . es  .   1    . indice du dernier tetraedre cree           .
  39 c . indptp . e   .   1    . indice du dernier pere enregistre          .
  40 c . tcod   . e   .   1    . type des codes des triangles dans les      .
  41 c .        .     .        . tetraedres                                 .
  42 c . trifad . e   .(4,0:2) . triangles traces sur les faces decoupees   .
  43 c . cotrvo . e   .(4,0:2) . code des triangles dans les volumes        .
  44 c . triint . e   .  22    . triangles internes a l'hexaedre            .
  45 c .        .     .        .  1-4 = bordant la pyramide 1               .
  46 c .        .     .        .  5-8 = bordant la pyramide 2               .
  47 c .        .     .        .  9-10 = s'appuyant sur les 2 autres aretes .
  48 c .        .     .        .         non decoupees                      .
  49 c .        .     .        .  11-14 = appuyes sur une arete interne a   .
  50 c .        .     .        .   une face coupee, du cote de la pyramide 1.
  51 c .        .     .        .  15-18 = appuyes sur une arete interne a   .
  52 c .        .     .        .   une face coupee, du cote de la pyramide 2.
  53 c .        .     .        .  19-22 = appuyes sur les filles des aretes .
  54 c .        .     .        .   coupees                                  .
  55 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  56 c . tritet . es  .nouvtf*4. numeros des 4 triangles des tetraedres     .
  57 c . cotrte . es  .nouvtf*4. code des 4 triangles des tetraedres        .
  58 c . filtet . es  . nouvte . premier fils des tetraedres                .
  59 c . pertet . es  . nouvte . pere des tetraedres                        .
  60 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  61 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  62 c . famtet . es  . nouvte . famille des tetraedres                     .
  63 c . famhex . e   . nouvhe . famille des hexaedres                      .
  64 c . cfahex .     . nctfhe. codes des familles des hexaedres            .
  65 c .        .     . nbfhex .   1 : famille MED                          .
  66 c .        .     .        .   2 : type d'hexaedres                     .
  67 c .        .     .        .   3 : famille des tetraedres de conformite .
  68 c .        .     .        .   4 : famille des pyramides de conformite  .
  69 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  70 c . langue . e   .    1   . langue des messages                        .
  71 c .        .     .        . 1 : francais, 2 : anglais                  .
  72 c . codret . es  .    1   . code de retour des modules                 .
  73 c .        .     .        . 0 : pas de probleme                        .
  74 c .        .     .        . 1 : aucune arete ne correspond             .
  75 c ______________________________________________________________________
  76 c
  77 c====
  78 c 0. declarations et dimensionnement
  79 c====
  80 c
  81 c 0.1. ==> generalites
  82 c
  83       implicit none
  84       save
  85 c
  86       character*6 nompro
  87       parameter ( nompro = 'CMCHAI' )
  88 c
  89 #include "nblang.h"
  90 c
  91 c 0.2. ==> communs
  92 c
  93 #include "envex1.h"
  94 c
  95 #include "dicfen.h"
  96 #include "nbfami.h"
  97 #include "nouvnb.h"
  98 #include "coftfh.h"
  99 c
 100 c 0.3. ==> arguments
 101 c
 102       integer lehexa, indtet, indptp, tcod
 103       integer trifad(4,0:2), cotrvo(4,0:2)
 104       integer triint(22)
 105       integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
 106       integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
 107       integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
 108 c
 109       integer ulsort, langue, codret
 110 c
 111 c 0.4. ==> variables locales
 112 c
 113       integer iaux
 114       integer nupere, nufami
 115       integer tb10(3,9), tb11(3,9), tb12(3,9)
 116       integer tb20(3,9), tb21(3,9), tb22(3,9)
 117       integer tb30(3,9), tb31(3,9), tb32(3,9)
 118       integer tb40(3,9), tb41(3,9), tb42(3,9)
 119 c
 120       integer nbmess
 121       parameter ( nbmess = 10 )
 122       character*80 texte(nblang,nbmess)
 123 c
 124 c 0.5. ==> initialisations
 125 c         tbi0 contient les codes pour le tetraedre central de la face i
 126 c         tbi1 contient les codes pour le tetraedre de la face i qui
 127 c              est du cote de la pyramide
 128 c         tbi2 contient les codes pour le tetraedre de la face i qui
 129 c              est de l'autre cote
 130 c         tbij(1,tcod) = code du 2-eme triangle
 131 c         tbij(2,tcod) = code du 3-eme triangle
 132 c         tbij(3,tcod) = code du 4-eme triangle
 133 c               tco=1 tco=2  tco=3 tco=4  tco=5 tco=6 tco=7 tco=8 tco=9
 134 c               1 2 3 1 2 3  1 2 3 1 2 3  1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
 135       data tb10/5,5,3,5,5,3, 5,5,3,5,5,3, 5,5,3,5,5,3,5,5,3,5,5,3,5,5,3/
 136       data tb11/5,3,5,5,3,3, 5,3,5,5,3,5, 5,3,5,5,3,5,5,3,3,5,3,3,5,3,5/
 137       data tb12/3,3,5,3,5,5, 3,3,5,5,3,5, 5,3,5,5,3,5,3,5,5,3,5,5,3,3,5/
 138 c
 139       data tb20/3,5,3,3,5,3, 3,5,3,5,5,3, 3,5,3,3,5,3,3,5,3,5,5,3,5,5,3/
 140       data tb21/5,5,5,5,3,5, 5,5,5,5,5,5, 5,5,5,5,5,5,5,3,5,5,3,5,5,5,5/
 141       data tb22/3,3,3,3,3,5, 3,3,3,3,3,3, 3,3,3,3,3,3,3,3,5,3,3,5,3,3,3/
 142 c
 143       data tb30/5,5,3,5,5,3, 5,5,3,5,5,3, 5,5,3,5,5,3,5,5,3,5,5,3,5,5,3/
 144       data tb31/5,3,5,5,3,5, 5,3,3,5,3,3, 5,3,5,5,3,3,5,3,3,5,3,3,5,3,3/
 145       data tb32/5,3,5,5,3,5, 5,5,5,3,5,5, 5,3,5,5,5,5,5,5,5,3,5,5,3,5,5/
 146 c
 147       data tb40/5,5,3,5,5,3, 5,5,3,3,5,3, 3,5,3,3,5,5,5,5,3,5,5,3,5,5,3/
 148       data tb41/5,5,5,5,5,5, 5,3,5,5,3,5, 5,5,5,5,3,5,5,3,5,5,3,5,5,3,5/
 149       data tb42/5,3,3,5,3,3, 5,3,5,5,3,5, 5,3,3,5,3,5,5,3,5,5,3,5,5,3,5/
 150 c               1 2 3 1 2 3  1 2 3 1 2 3  1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
 151 c               tco=1 tco=2  tco=3 tco=4  tco=5 tco=6 tco=7 tco=8 tco=9
 152 c ______________________________________________________________________
 153 c
 154 c====
 155 c 1. initialisations
 156 c====
 157 c
 158 #include "impr01.h"
 159 c
 160 #ifdef _DEBUG_HOMARD_
 161       write (ulsort,texte(langue,1)) 'Entree', nompro
 162       call dmflsh (iaux)
 163 #endif
 164 c
 165       codret = 0
 166 cgn      print *,tb10(1,tcod),tb10(2,tcod),tb10(3,tcod)
 167 cgn      print *,tb11(1,tcod),tb11(3,tcod)
 168 cgn      print *,tb12(1,tcod),tb12(3,tcod)
 169 cgn      print *,tb20(1,tcod),tb20(2,tcod),tb20(3,tcod)
 170 cgn      print *,tb21(1,tcod),tb21(3,tcod)
 171 cgn      print *,tb22(1,tcod),tb22(3,tcod)
 172 cgn      print *,tb30(1,tcod),tb30(2,tcod),tb30(3,tcod)
 173 cgn      print *,tb31(1,tcod),tb31(3,tcod)
 174 cgn      print *,tb32(1,tcod),tb32(3,tcod)
 175 cgn      print *,tb40(1,tcod),tb40(2,tcod),tb40(3,tcod)
 176 cgn      print *,tb41(1,tcod),tb41(3,tcod)
 177 cgn      print *,tb42(1,tcod),tb42(3,tcod)
 178 c
 179 c 1.2. ==> Le pere des tetraedres et leur famille
 180 c
 181       nupere = -indptp
 182       nufami = cfahex(coftfh,famhex(lehexa))
 183 c
 184 #ifdef _DEBUG_HOMARD_
 185       write (ulsort,texte(langue,3)) 'CMCHxx', nompro
 186       write (ulsort,1200) indtet+1, indtet+12
 187  1200 format( '.. tetraedres de',i10,' a',i10)
 188 #endif
 189 c
 190 c====
 191 c 2. Face 1
 192 c====
 193 c 2.1. ==> tetraedre central
 194 c
 195       indtet = indtet + 1
 196       call cmctet ( tritet, cotrte, famtet,
 197      >              hettet, filtet, pertet,
 198      >              trifad(1,0), triint(7), triint(15), triint(11),
 199      >              cotrvo(1,0), tb10(1,tcod),tb10(2,tcod),tb10(3,tcod),
 200      >              nupere, nufami, indtet )
 201 c
 202 c 2.2. ==> tetraedre du cote de la pyramide
 203 c
 204       indtet = indtet + 1
 205       call cmctet ( tritet, cotrte, famtet,
 206      >              hettet, filtet, pertet,
 207      >              trifad(1,1), triint(2),   triint(11),   triint(19),
 208      >              cotrvo(1,1), tb11(1,tcod),tb11(2,tcod),tb11(3,tcod),
 209      >              nupere, nufami, indtet )
 210 c
 211 c 2.3. ==> tetraedre de l'autre cote
 212 c
 213       indtet = indtet + 1
 214       call cmctet ( tritet, cotrte, famtet,
 215      >              hettet, filtet, pertet,
 216      >              trifad(1,2), triint(9),   triint(21),   triint(15),
 217      >              cotrvo(1,2), tb12(1,tcod),tb12(2,tcod),tb12(3,tcod),
 218      >              nupere, nufami, indtet )
 219 c
 220 c====
 221 c 3. Face 2
 222 c====
 223 c 3.1. ==> tetraedre central
 224 c
 225       indtet = indtet + 1
 226       call cmctet ( tritet, cotrte, famtet,
 227      >              hettet, filtet, pertet,
 228      >              trifad(2,0), triint(10),  triint(12), triint(16),
 229      >              cotrvo(2,0), tb20(1,tcod),tb20(2,tcod),tb20(3,tcod),
 230      >              nupere, nufami, indtet )
 231 c
 232 c 3.2. ==> tetraedre du cote de la pyramide
 233 c
 234       indtet = indtet + 1
 235       call cmctet ( tritet, cotrte, famtet,
 236      >              hettet, filtet, pertet,
 237      >              trifad(2,1), triint(3),   triint(19),   triint(12),
 238      >              cotrvo(2,1), tb21(1,tcod),tb21(2,tcod),tb21(3,tcod),
 239      >              nupere, nufami, indtet )
 240 c
 241 c 3.3. ==> tetraedre de l'autre cote
 242 c
 243       indtet = indtet + 1
 244       call cmctet ( tritet, cotrte, famtet,
 245      >              hettet, filtet, pertet,
 246      >              trifad(2,2), triint(8),   triint(16),   triint(21),
 247      >              cotrvo(2,2), tb22(1,tcod),tb22(2,tcod),tb22(3,tcod),
 248      >              nupere, nufami, indtet )
 249 c
 250 c====
 251 c 4. Face 3
 252 c====
 253 c 4.1. ==> tetraedre central
 254 c
 255       indtet = indtet + 1
 256       call cmctet ( tritet, cotrte, famtet,
 257      >              hettet, filtet, pertet,
 258      >              trifad(3,0), triint(4), triint(17), triint(13),
 259      >              cotrvo(3,0), tb30(1,tcod),tb30(2,tcod),tb30(3,tcod),
 260      >              nupere, nufami, indtet )
 261 c
 262 c 4.2. ==> tetraedre du cote de la pyramide
 263 c
 264       indtet = indtet + 1
 265       call cmctet ( tritet, cotrte, famtet,
 266      >              hettet, filtet, pertet,
 267      >              trifad(3,1),  triint(5),  triint(13),   triint(20),
 268      >              cotrvo(3,1), tb31(1,tcod),tb31(2,tcod),tb31(3,tcod),
 269      >              nupere, nufami, indtet )
 270 c
 271 c 4.3. ==> tetraedre de l'autre cote
 272 c
 273       indtet = indtet + 1
 274       call cmctet ( tritet, cotrte, famtet,
 275      >              hettet, filtet, pertet,
 276      >              trifad(3,2), triint(10),   triint(22),   triint(17),
 277      >              cotrvo(3,2), tb32(1,tcod),tb32(2,tcod),tb32(3,tcod),
 278      >              nupere, nufami, indtet )
 279 c
 280 c====
 281 c 5. Face 4
 282 c====
 283 c 5.1. ==> tetraedre central
 284 c
 285       indtet = indtet + 1
 286       call cmctet ( tritet, cotrte, famtet,
 287      >              hettet, filtet, pertet,
 288      >              trifad(4,0), triint(9), triint(14), triint(18),
 289      >              cotrvo(4,0), tb40(1,tcod),tb40(2,tcod),tb40(3,tcod),
 290      >              nupere, nufami, indtet )
 291 c
 292 c 5.2. ==> tetraedre du cote de la pyramide
 293 c
 294       indtet = indtet + 1
 295       call cmctet ( tritet, cotrte, famtet,
 296      >              hettet, filtet, pertet,
 297      >              trifad(4,1), triint(6),   triint(20),   triint(14),
 298      >              cotrvo(4,1), tb41(1,tcod),tb41(2,tcod),tb41(3,tcod),
 299      >              nupere, nufami, indtet )
 300 c
 301 c 5.3. ==> tetraedre de l'autre cote
 302 c
 303       indtet = indtet + 1
 304       call cmctet ( tritet, cotrte, famtet,
 305      >              hettet, filtet, pertet,
 306      >              trifad(4,2), triint(8),   triint(18),   triint(22),
 307      >              cotrvo(4,2), tb42(1,tcod),tb42(2,tcod),tb42(3,tcod),
 308      >              nupere, nufami, indtet )
 309 c
 310 #ifdef _DEBUG_HOMARD_
 311       do 2222 , iaux = indtet-11, indtet
 312       write(ulsort,1789) iaux, (tritet(iaux,tcod),tcod=1,4),
 313      > (cotrte(iaux,tcod),tcod=1,4)
 314  2222 continue
 315  1789 format('tetraedre ',i6,' : ',4i6,4i2)
 316 #endif
 317 c
 318 c====
 319 c 6. la fin
 320 c====
 321 c
 322       if ( codret.ne.0 ) then
 323 c
 324 #include "envex2.h"
 325 c
 326       write (ulsort,texte(langue,1)) 'Sortie', nompro
 327       write (ulsort,texte(langue,2)) codret
 328 c
 329       endif
 330 c
 331 #ifdef _DEBUG_HOMARD_
 332       write (ulsort,texte(langue,1)) 'Sortie', nompro
 333       call dmflsh (iaux)
 334 #endif
 335 c
 336       end