src/tool/Creation_Maillage/cmcham.F

   1       subroutine cmcham ( lehexa, etahex, indtet, indptp,
   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 3 Aretes - phase M
  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 . etahex . e   .   1    . etat de l'hexaedre                         .
  39 c . indtet . es  .   1    . indice du dernier tetraedre cree           .
  40 c . indptp . e   .   1    . indice du dernier pere enregistre          .
  41 c . trifad . e   .(6,0:2) . triangles traces sur les faces decoupees   .
  42 c . cotrvo . e   .(6,0:2) . code des triangles dans les volumes        .
  43 c . triint .  s  .  27    . triangles internes a l'hexaedre            .
  44 c .        .     .        .  1-6 = appuyes sur une arete non decoupee  .
  45 c .        .     .        .   base de face centrale                    .
  46 c .        .     .        .  7-9 = appuyes sur une arete non decoupee  .
  47 c .        .     .        .   non base de face centrale                .
  48 c .        .     .        .  10-21 = appuyes sur une arete interne a   .
  49 c .        .     .        .   une face coupee                          .
  50 c .        .     .        .  22-27 = appuyes sur les filles des aretes .
  51 c .        .     .        .   coupees                                  .
  52 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  53 c . tritet . es  .nouvtf*4. numeros des 4 triangles des tetraedres     .
  54 c . cotrte . es  .nouvtf*4. code des 4 triangles des tetraedres        .
  55 c . filtet . es  . nouvte . premier fils des tetraedres                .
  56 c . pertet . es  . nouvte . pere des tetraedres                        .
  57 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  58 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  59 c . famtet . es  . nouvte . famille des tetraedres                     .
  60 c . famhex . e   . nouvhe . famille des hexaedres                      .
  61 c . cfahex .     . nctfhe. codes des familles des hexaedres            .
  62 c .        .     . nbfhex .   1 : famille MED                          .
  63 c .        .     .        .   2 : type d'hexaedres                     .
  64 c .        .     .        .   3 : famille des tetraedres de conformite .
  65 c .        .     .        .   4 : famille des pyramides de conformite  .
  66 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  67 c . langue . e   .    1   . langue des messages                        .
  68 c .        .     .        . 1 : francais, 2 : anglais                  .
  69 c . codret . es  .    1   . code de retour des modules                 .
  70 c .        .     .        . 0 : pas de probleme                        .
  71 c .        .     .        . 1 : aucune arete ne correspond             .
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 0. declarations et dimensionnement
  76 c====
  77 c
  78 c 0.1. ==> generalites
  79 c
  80       implicit none
  81       save
  82 c
  83       character*6 nompro
  84       parameter ( nompro = 'CMCHAM' )
  85 c
  86 #include "nblang.h"
  87 c
  88 c 0.2. ==> communs
  89 c
  90 #include "envex1.h"
  91 c
  92 #include "dicfen.h"
  93 #include "nbfami.h"
  94 #include "nouvnb.h"
  95 #include "coftfh.h"
  96 c
  97 c 0.3. ==> arguments
  98 c
  99       integer lehexa, etahex, indtet, indptp
 100       integer trifad(6,0:2), cotrvo(6,0:2)
 101       integer triint(27)
 102       integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
 103       integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
 104       integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
 105 c
 106       integer ulsort, langue, codret
 107 c
 108 c 0.4. ==> variables locales
 109 c
 110       integer iaux
 111       integer nupere, nufami
 112       integer code
 113 c
 114       integer nbmess
 115       parameter ( nbmess = 10 )
 116       character*80 texte(nblang,nbmess)
 117 c
 118 c 0.5. ==> initialisations
 119 c ______________________________________________________________________
 120 c
 121 c====
 122 c 1. initialisations
 123 c====
 124 c
 125 #include "impr01.h"
 126 c
 127 #ifdef _DEBUG_HOMARD_
 128       write (ulsort,texte(langue,1)) 'Entree', nompro
 129       call dmflsh (iaux)
 130 #endif
 131 c
 132       codret = 0
 133 c
 134 #ifdef _DEBUG_HOMARD_
 135       write (ulsort,texte(langue,3)) 'CMCHxx', nompro
 136       write (ulsort,1200) indtet+1, indtet+18
 137  1200 format( '.. tetraedres de',i10,' a',i10)
 138 #endif
 139 c
 140 c 1.2. ==> Le pere des tetraedres et leur famille
 141 c
 142       nupere = -indptp
 143       nufami = cfahex(coftfh,famhex(lehexa))
 144 c
 145 c====
 146 c 2. Face 1
 147 c====
 148 c 2.1. ==> tetraedre central
 149 c
 150       indtet = indtet + 1
 151       call cmctet ( tritet, cotrte, famtet,
 152      >              hettet, filtet, pertet,
 153      >              trifad(1,0), triint(1), triint(11), triint(10),
 154      >              cotrvo(1,0),         3,          5,          3,
 155      >              nupere, nufami, indtet )
 156 c
 157 c 2.2. ==> tetraedre du cote du sommet 1
 158 c
 159       if ( etahex.eq.82 .or. etahex.eq.86 ) then
 160         code = 3
 161       else
 162         code = 5
 163       endif
 164       indtet = indtet + 1
 165       call cmctet ( tritet, cotrte, famtet,
 166      >              hettet, filtet, pertet,
 167      >              trifad(1,1), triint(3), triint(10), triint(22),
 168      >              cotrvo(1,1),      code,          3,          5,
 169      >              nupere, nufami, indtet )
 170 c
 171 c 2.3. ==> tetraedre de l'autre cote
 172 c
 173       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 174         code = 3
 175       else
 176         code = 5
 177       endif
 178       indtet = indtet + 1
 179       call cmctet ( tritet, cotrte, famtet,
 180      >              hettet, filtet, pertet,
 181      >              trifad(1,2), triint(8), triint(23), triint(11),
 182      >              cotrvo(1,2),      code,          3,          5,
 183      >              nupere, nufami, indtet )
 184 c
 185 c====
 186 c 3. Face 2
 187 c====
 188 c 3.1. ==> tetraedre central
 189 c
 190       indtet = indtet + 1
 191       call cmctet ( tritet, cotrte, famtet,
 192      >              hettet, filtet, pertet,
 193      >              trifad(2,0), triint(2), triint(12), triint(13),
 194      >              cotrvo(2,0),         3,          5,          3,
 195      >              nupere, nufami, indtet )
 196 c
 197 c 3.2. ==> tetraedre du cote du sommet 1
 198 c
 199       indtet = indtet + 1
 200       call cmctet ( tritet, cotrte, famtet,
 201      >              hettet, filtet, pertet,
 202      >              trifad(2,1), triint(9), triint(22), triint(12),
 203      >              cotrvo(2,1),         3,          5,          5,
 204      >              nupere, nufami, indtet )
 205 c
 206 c 3.3. ==> tetraedre de l'autre cote
 207 c
 208       indtet = indtet + 1
 209       call cmctet ( tritet, cotrte, famtet,
 210      >              hettet, filtet, pertet,
 211      >              trifad(2,2), triint(6), triint(13), triint(23),
 212      >              cotrvo(2,2),         3,          3,          3,
 213      >              nupere, nufami, indtet )
 214 c
 215 c====
 216 c 4. Face 3
 217 c====
 218 c 4.1. ==> tetraedre central
 219 c
 220       if ( etahex.eq.82 .or. etahex.eq.86 ) then
 221         code = 5
 222       else
 223         code = 3
 224       endif
 225       indtet = indtet + 1
 226       call cmctet ( tritet, cotrte, famtet,
 227      >              hettet, filtet, pertet,
 228      >              trifad(3,0), triint(3), triint(15), triint(14),
 229      >              cotrvo(3,0),      code,          5,          3,
 230      >              nupere, nufami, indtet )
 231 c
 232 c 4.2. ==> tetraedre du cote du sommet 1
 233 c
 234       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 235         code = 3
 236       else
 237         code = 5
 238       endif
 239       indtet = indtet + 1
 240       call cmctet ( tritet, cotrte, famtet,
 241      >              hettet, filtet, pertet,
 242      >              trifad(3,1), triint(5),  triint(14), triint(24),
 243      >              cotrvo(3,1),         3,          3,       code,
 244      >              nupere, nufami, indtet )
 245 c
 246 c 4.3. ==> tetraedre de l'autre cote
 247 c
 248       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 249         code = 5
 250       else
 251         code = 3
 252       endif
 253       indtet = indtet + 1
 254       call cmctet ( tritet, cotrte, famtet,
 255      >              hettet, filtet, pertet,
 256      >              trifad(3,2), triint(9), triint(25), triint(15),
 257      >              cotrvo(3,2),         5,       code,          5,
 258      >              nupere, nufami, indtet )
 259 c
 260 c====
 261 c 5. Face 4
 262 c====
 263 c 5.1. ==> tetraedre central
 264 c
 265       if ( etahex.eq.82 .or. etahex.eq.86 ) then
 266         code = 5
 267       else
 268         code = 3
 269       endif
 270       indtet = indtet + 1
 271       call cmctet ( tritet, cotrte, famtet,
 272      >              hettet, filtet, pertet,
 273      >              trifad(4,0), triint(4), triint(16), triint(17),
 274      >              cotrvo(4,0),      code,          5,          3,
 275      >              nupere, nufami, indtet )
 276 c
 277 c 5.2. ==> tetraedre du cote du sommet 1
 278 c
 279       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 280         code = 3
 281       else
 282         code = 5
 283       endif
 284       indtet = indtet + 1
 285       call cmctet ( tritet, cotrte, famtet,
 286      >              hettet, filtet, pertet,
 287      >              trifad(4,1), triint(7), triint(24), triint(16),
 288      >              cotrvo(4,1),         3,       code,          5,
 289      >              nupere, nufami, indtet )
 290 c
 291 c 5.3. ==> tetraedre de l'autre cote
 292 c
 293       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 294         code = 5
 295       else
 296         code = 3
 297       endif
 298       indtet = indtet + 1
 299       call cmctet ( tritet, cotrte, famtet,
 300      >              hettet, filtet, pertet,
 301      >              trifad(4,2), triint(2), triint(17), triint(25),
 302      >              cotrvo(4,2),         5,          3,       code,
 303      >              nupere, nufami, indtet )
 304 c
 305 c====
 306 c 6. Face 5
 307 c====
 308 c 6.1. ==> tetraedre central
 309 c
 310       indtet = indtet + 1
 311       call cmctet ( tritet, cotrte, famtet,
 312      >              hettet, filtet, pertet,
 313      >              trifad(5,0), triint(5), triint(19), triint(18),
 314      >              cotrvo(5,0),         5,          5,          3,
 315      >              nupere, nufami, indtet )
 316 c
 317 c 6.2. ==> tetraedre du cote du sommet 1
 318 c
 319       indtet = indtet + 1
 320       call cmctet ( tritet, cotrte, famtet,
 321      >              hettet, filtet, pertet,
 322      >              trifad(5,1), triint(1), triint(18), triint(26),
 323      >              cotrvo(5,1),         5,          3,          5,
 324      >              nupere, nufami, indtet )
 325 c
 326 c 6.3. ==> tetraedre de l'autre cote
 327 c
 328       indtet = indtet + 1
 329       call cmctet ( tritet, cotrte, famtet,
 330      >              hettet, filtet, pertet,
 331      >              trifad(5,2), triint(7), triint(27), triint(19),
 332      >              cotrvo(5,2),         5,          3,          5,
 333      >              nupere, nufami, indtet )
 334 c
 335 c====
 336 c 7. Face 6
 337 c====
 338 c 7.1. ==> tetraedre central
 339 c
 340       indtet = indtet + 1
 341       call cmctet ( tritet, cotrte, famtet,
 342      >              hettet, filtet, pertet,
 343      >              trifad(6,0), triint(6), triint(20), triint(21),
 344      >              cotrvo(6,0),         5,          5,          3,
 345      >              nupere, nufami, indtet )
 346 c
 347 c 7.2. ==> tetraedre du cote du sommet 1
 348 c
 349       if ( etahex.eq.82 .or. etahex.eq.83 ) then
 350         code = 5
 351       else
 352         code = 3
 353       endif
 354       indtet = indtet + 1
 355       call cmctet ( tritet, cotrte, famtet,
 356      >              hettet, filtet, pertet,
 357      >              trifad(6,1), triint(8), triint(26), triint(20),
 358      >              cotrvo(6,1),      code,          5,          5,
 359      >              nupere, nufami, indtet )
 360 c
 361 c 7.3. ==> tetraedre de l'autre cote
 362 c
 363       if ( etahex.eq.82 .or. etahex.eq.86 ) then
 364         code = 3
 365       else
 366         code = 5
 367       endif
 368       indtet = indtet + 1
 369       call cmctet ( tritet, cotrte, famtet,
 370      >              hettet, filtet, pertet,
 371      >              trifad(6,2), triint(4), triint(21), triint(27),
 372      >              cotrvo(6,2),      code,          3,          3,
 373      >              nupere, nufami, indtet )
 374 c
 375 #ifdef _DEBUG_HOMARD_
 376       do 2222 , iaux = indtet-17, indtet
 377       write(ulsort,1789) iaux, (tritet(iaux,code),code=1,4),
 378      > (cotrte(iaux,code),code=1,4)
 379  2222 continue
 380  1789 format('tetraedre ',i6,' : ',4i6,4i2)
 381 #endif
 382 c
 383 c====
 384 c 8. la fin
 385 c====
 386 c
 387       if ( codret.ne.0 ) then
 388 c
 389 #include "envex2.h"
 390 c
 391       write (ulsort,texte(langue,1)) 'Sortie', nompro
 392       write (ulsort,texte(langue,2)) codret
 393 c
 394       endif
 395 c
 396 #ifdef _DEBUG_HOMARD_
 397       write (ulsort,texte(langue,1)) 'Sortie', nompro
 398       call dmflsh (iaux)
 399 #endif
 400 c
 401       end