src/tool/Creation_Maillage/cmchae.F

   1       subroutine cmchae ( 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 en vis-a-vis - phase E
  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 = 'CMCHAE' )
  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 tb11(2,2), tb12(2,2)
 116       integer tb21(2,2), tb22(2,2)
 117       integer tb31(2,2), tb32(2,2)
 118       integer tb41(2,2), tb42(2,2)
 119 c
 120       integer nbmess
 121       parameter ( nbmess = 10 )
 122       character*80 texte(nblang,nbmess)
 123 c
 124 c 0.5. ==> initialisations
 125 c         tbij contient les codes pour le tetraedre de la face i qui
 126 c              est du cote de la pyramide j
 127 c         tbij(1,tcod) = code du 3-eme triangle
 128 c         tbij(2,tcod) = code du 4-eme triangle
 129 c                   tcod = 1       tcod = 2
 130 c                 (1,1)  (2,1)   (1,2)  (2,2)
 131       data tb11 /   3,     3,      3,     5  /
 132       data tb12 /   5,     5,      3,     5  /
 133       data tb21 /   3,     5,      5,     5  /
 134       data tb22 /   3,     5,      3,     3  /
 135       data tb31 /   3,     5,      3,     3  /
 136       data tb32 /   3,     5,      5,     5  /
 137       data tb41 /   5,     5,      3,     5  /
 138       data tb42 /   3,     3,      3,     5  /
 139 c ______________________________________________________________________
 140 c
 141 c====
 142 c 1. initialisations
 143 c====
 144 c
 145 #include "impr01.h"
 146 c
 147 #ifdef _DEBUG_HOMARD_
 148       write (ulsort,texte(langue,1)) 'Entree', nompro
 149       call dmflsh (iaux)
 150 #endif
 151 c
 152       codret = 0
 153 cgn      print *,tb11(1,tcod),tb11(2,tcod)
 154 cgn      print *,tb12(1,tcod),tb12(2,tcod)
 155 cgn      print *,tb21(1,tcod),tb21(2,tcod)
 156 cgn      print *,tb22(1,tcod),tb22(2,tcod)
 157 cgn      print *,tb31(1,tcod),tb31(2,tcod)
 158 cgn      print *,tb32(1,tcod),tb32(2,tcod)
 159 cgn      print *,tb41(1,tcod),tb41(2,tcod)
 160 cgn      print *,tb42(1,tcod),tb42(2,tcod)
 161 c
 162 c 1.2. ==> Le pere des tetraedres et leur famille
 163 c
 164       nupere = -indptp
 165       nufami = cfahex(coftfh,famhex(lehexa))
 166 c
 167 #ifdef _DEBUG_HOMARD_
 168       write (ulsort,texte(langue,3)) 'CMCHxx', nompro
 169       write (ulsort,1200) indtet+1, indtet+12
 170  1200 format( '.. tetraedres de',i10,' a',i10)
 171 #endif
 172 c
 173 c====
 174 c 2. Face 1
 175 c====
 176 c 2.1. ==> tetraedre central
 177 c
 178       indtet = indtet + 1
 179       call cmctet ( tritet, cotrte, famtet,
 180      >              hettet, filtet, pertet,
 181      >              trifad(1,0), triint(10), triint(15), triint(11),
 182      >              cotrvo(1,0),          3,          5,          3,
 183      >              nupere, nufami, indtet )
 184 c
 185 c 2.2. ==> tetraedre du cote de la pyramide 1
 186 c
 187       indtet = indtet + 1
 188       call cmctet ( tritet, cotrte, famtet,
 189      >              hettet, filtet, pertet,
 190      >              trifad(1,1), triint(1),   triint(11),   triint(19),
 191      >              cotrvo(1,1),         5, tb11(1,tcod), tb11(2,tcod),
 192      >              nupere, nufami, indtet )
 193 c
 194 c 2.3. ==> tetraedre du cote de la pyramide 2
 195 c
 196       indtet = indtet + 1
 197       call cmctet ( tritet, cotrte, famtet,
 198      >              hettet, filtet, pertet,
 199      >              trifad(1,2), triint(5),   triint(21),   triint(15),
 200      >              cotrvo(1,2),         5, tb12(1,tcod), tb12(2,tcod),
 201      >              nupere, nufami, indtet )
 202 c
 203 c====
 204 c 3. Face 2
 205 c====
 206 c 3.1. ==> tetraedre central
 207 c
 208       indtet = indtet + 1
 209       call cmctet ( tritet, cotrte, famtet,
 210      >              hettet, filtet, pertet,
 211      >              trifad(2,0), triint( 9), triint(12), triint(16),
 212      >              cotrvo(2,0),          3,          5,          3,
 213      >              nupere, nufami, indtet )
 214 c
 215 c 3.2. ==> tetraedre du cote de la pyramide 1
 216 c
 217       indtet = indtet + 1
 218       call cmctet ( tritet, cotrte, famtet,
 219      >              hettet, filtet, pertet,
 220      >              trifad(2,1), triint(2),   triint(19),   triint(12),
 221      >              cotrvo(2,1),         5, tb21(1,tcod), tb21(2,tcod),
 222      >              nupere, nufami, indtet )
 223 c
 224 c 3.3. ==> tetraedre du cote de la pyramide 2
 225 c
 226       indtet = indtet + 1
 227       call cmctet ( tritet, cotrte, famtet,
 228      >              hettet, filtet, pertet,
 229      >              trifad(2,2), triint(6),   triint(16),   triint(21),
 230      >              cotrvo(2,2),         5, tb22(1,tcod), tb22(2,tcod),
 231      >              nupere, nufami, indtet )
 232 c
 233 c====
 234 c 4. Face 3
 235 c====
 236 c 4.1. ==> tetraedre central
 237 c
 238       indtet = indtet + 1
 239       call cmctet ( tritet, cotrte, famtet,
 240      >              hettet, filtet, pertet,
 241      >              trifad(3,0), triint(9), triint(17), triint(13),
 242      >              cotrvo(3,0),        5,          5,           3,
 243      >              nupere, nufami, indtet )
 244 c
 245 c 4.2. ==> tetraedre du cote de la pyramide 1
 246 c
 247       indtet = indtet + 1
 248       call cmctet ( tritet, cotrte, famtet,
 249      >              hettet, filtet, pertet,
 250      >              trifad(3,1),  triint(3),  triint(13),   triint(20),
 251      >              cotrvo(3,1),         5, tb31(1,tcod), tb31(2,tcod),
 252      >              nupere, nufami, indtet )
 253 c
 254 c 4.3. ==> tetraedre du cote de la pyramide 2
 255 c
 256       indtet = indtet + 1
 257       call cmctet ( tritet, cotrte, famtet,
 258      >              hettet, filtet, pertet,
 259      >              trifad(3,2), triint(7),   triint(22),   triint(17),
 260      >              cotrvo(3,2),         5, tb32(1,tcod), tb32(2,tcod),
 261      >              nupere, nufami, indtet )
 262 c
 263 c====
 264 c 5. Face 4
 265 c====
 266 c 5.1. ==> tetraedre central
 267 c
 268       indtet = indtet + 1
 269       call cmctet ( tritet, cotrte, famtet,
 270      >              hettet, filtet, pertet,
 271      >              trifad(4,0), triint(10), triint(14), triint(18),
 272      >              cotrvo(4,0),          5,          5,          3,
 273      >              nupere, nufami, indtet )
 274 c
 275 c 5.2. ==> tetraedre du cote de la pyramide 1
 276 c
 277       indtet = indtet + 1
 278       call cmctet ( tritet, cotrte, famtet,
 279      >              hettet, filtet, pertet,
 280      >              trifad(4,1), triint(4),   triint(20),   triint(14),
 281      >              cotrvo(4,1),         5, tb41(1,tcod), tb41(2,tcod),
 282      >              nupere, nufami, indtet )
 283 c
 284 c 5.3. ==> tetraedre du cote de la pyramide 2
 285 c
 286       indtet = indtet + 1
 287       call cmctet ( tritet, cotrte, famtet,
 288      >              hettet, filtet, pertet,
 289      >              trifad(4,2), triint(8),   triint(18),   triint(22),
 290      >              cotrvo(4,2),         5, tb42(1,tcod), tb42(2,tcod),
 291      >              nupere, nufami, indtet )
 292 c
 293 #ifdef _DEBUG_HOMARD_
 294       do 2222 , iaux = indtet-11, indtet
 295       write(ulsort,1789) iaux, (tritet(iaux,tcod),tcod=1,4),
 296      > (cotrte(iaux,tcod),tcod=1,4)
 297  2222 continue
 298  1789 format('tetraedre ',i6,' : ',4i6,4i2)
 299 #endif
 300 c
 301 c====
 302 c 6. la fin
 303 c====
 304 c
 305       if ( codret.ne.0 ) then
 306 c
 307 #include "envex2.h"
 308 c
 309       write (ulsort,texte(langue,1)) 'Sortie', nompro
 310       write (ulsort,texte(langue,2)) codret
 311 c
 312       endif
 313 c
 314 #ifdef _DEBUG_HOMARD_
 315       write (ulsort,texte(langue,1)) 'Sortie', nompro
 316       call dmflsh (iaux)
 317 #endif
 318 c
 319       end