src/tool/Creation_Maillage/cmchaw.F

   1       subroutine cmchaw ( indtri, triint,
   2      >                    lesare,
   3      >                    trifad, areint, areqtr, niveau,
   4      >                    aretri, famtri, hettri,
   5      >                    filtri, pertri, nivtri,
   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 W
  30 c                                 -              -
  31 c    Remarque : cmchap, cmchaq, cmchar et cmchas sont des clones
  32 c               cmchat, cmchau, cmchav et cmchaw sont des clones
  33 c               tous sont similaires
  34 c ______________________________________________________________________
  35 c .        .     .        .                                            .
  36 c .  nom   . e/s . taille .           description                      .
  37 c .____________________________________________________________________.
  38 c . indtri . es  .   1    . indice du dernier triangle cree            .
  39 c . triint .  s  .  27    . triangles internes a l'hexaedre            .
  40 c .        .     .        .  1-6 = appuyes sur une arete non decoupee  .
  41 c .        .     .        .   base de face centrale                    .
  42 c .        .     .        .  7-9 = appuyes sur une arete non decoupee  .
  43 c .        .     .        .   non base de face centrale                .
  44 c .        .     .        .  10-21 = appuyes sur une arete interne a   .
  45 c .        .     .        .   une face coupee                          .
  46 c .        .     .        .  22-27 = appuyes sur les filles des aretes .
  47 c .        .     .        .   coupees                                  .
  48 c . lesare . e   .   9    . liste des aretes non coupees               .
  49 c .        .     .        .  1-6 = base de la face i                   .
  50 c .        .     .        .  6+i = opposee a la ieme arete decoupee    .
  51 c . trifad . e   .(6,0:2) . triangles traces sur les faces decoupees   .
  52 c . areint . e  .    11   . aretes internes a l'hexaedre               .
  53 c . areqtr . e  .   (6,2) . aretes sur les faces coupees               .
  54 c . aretri . es  .nouvtr*3. numeros des 3 aretes des triangles         .
  55 c . hettri . es  . nouvtr . historique de l'etat des triangles         .
  56 c . filtri . es  . nouvtr . premier fils des triangles                 .
  57 c . pertri . es  . nouvtr . pere des triangles                         .
  58 c . nivtri . es  . nouvtr . niveau des triangles                       .
  59 c . famtri . es  . nouvtr . famille des triangles                      .
  60 c . areint . e   .   10   . aretes internes creees                     .
  61 c . niveau . e   . 1      . niveau a attribuer aux triangles           .
  62 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  63 c . langue . e   .    1   . langue des messages                        .
  64 c .        .     .        . 1 : francais, 2 : anglais                  .
  65 c . codret . es  .    1   . code de retour des modules                 .
  66 c .        .     .        . 0 : pas de probleme                        .
  67 c .        .     .        . 1 : aucune arete ne correspond             .
  68 c ______________________________________________________________________
  69 c
  70 c====
  71 c 0. declarations et dimensionnement
  72 c====
  73 c
  74 c 0.1. ==> generalites
  75 c
  76       implicit none
  77       save
  78 c
  79       character*6 nompro
  80       parameter ( nompro = 'CMCHAW' )
  81 c
  82 #include "nblang.h"
  83 c
  84 c 0.2. ==> communs
  85 c
  86 #include "envex1.h"
  87 c
  88 #include "nouvnb.h"
  89 c
  90 c 0.3. ==> arguments
  91 c
  92       integer indtri
  93       integer niveau
  94       integer triint(27)
  95       integer lesare(9)
  96       integer trifad(6,0:2)
  97       integer areint(11)
  98       integer areqtr(6,2)
  99       integer aretri(nouvtr,3), famtri(nouvtr)
 100       integer hettri(nouvtr), filtri(nouvtr), pertri(nouvtr)
 101       integer nivtri(nouvtr)
 102 c
 103       integer ulsort, langue, codret
 104 c
 105 c 0.4. ==> variables locales
 106 c
 107       integer iaux, jaux
 108       integer codetr
 109 c
 110       integer nbmess
 111       parameter ( nbmess = 10 )
 112       character*80 texte(nblang,nbmess)
 113 c
 114 c 0.5. ==> initialisations
 115 c ______________________________________________________________________
 116 c
 117 c====
 118 c 1. initialisations
 119 c====
 120 c
 121 c 1.1. ==> messages
 122 c
 123 #include "impr01.h"
 124 c
 125 #ifdef _DEBUG_HOMARD_
 126       write (ulsort,texte(langue,1)) 'Entree', nompro
 127       call dmflsh (iaux)
 128 #endif
 129 c
 130       codret = 0
 131 c
 132       codetr = 1
 133 c
 134 c====
 135 c 2. 1-6 : les triangles base de face centrale
 136 c          le i-eme triangle est sur la face i de l'hexaedre
 137 c====
 138 c
 139       iaux = 1
 140       indtri = indtri + 1
 141       triint(iaux) = indtri
 142       call cmctri ( aretri, famtri, hettri,
 143      >              filtri, pertri, nivtri,
 144      >              indtri, lesare(iaux), areint(7), areint(5),
 145      >              codetr, niveau )
 146 c
 147       iaux = iaux + 1
 148       indtri = indtri + 1
 149       triint(iaux) = indtri
 150       call cmctri ( aretri, famtri, hettri,
 151      >              filtri, pertri, nivtri,
 152      >              indtri, lesare(iaux), areint(8), areint(4),
 153      >              codetr, niveau )
 154 c
 155       iaux = iaux + 1
 156       indtri = indtri + 1
 157       triint(iaux) = indtri
 158       call cmctri ( aretri, famtri, hettri,
 159      >              filtri, pertri, nivtri,
 160      >              indtri, lesare(iaux), areint(7), areint(1),
 161      >              codetr, niveau )
 162 c
 163       iaux = iaux + 1
 164       indtri = indtri + 1
 165       triint(iaux) = indtri
 166       call cmctri ( aretri, famtri, hettri,
 167      >              filtri, pertri, nivtri,
 168      >              indtri, lesare(iaux), areint(8), areint(6),
 169      >              codetr, niveau )
 170 c
 171       iaux = iaux + 1
 172       indtri = indtri + 1
 173       triint(iaux) = indtri
 174       call cmctri ( aretri, famtri, hettri,
 175      >              filtri, pertri, nivtri,
 176      >              indtri, lesare(iaux), areint(3), areint(7),
 177      >              codetr, niveau )
 178 c
 179       iaux = iaux + 1
 180       indtri = indtri + 1
 181       triint(iaux) = indtri
 182       call cmctri ( aretri, famtri, hettri,
 183      >              filtri, pertri, nivtri,
 184      >              indtri, lesare(iaux), areint(2), areint(8),
 185      >              codetr, niveau )
 186 c
 187 c====
 188 c 3. 7-9 : les 3 autres triangles sur des aretes non decoupees
 189 c          la base du i-eme triangle est // a la i-eme arete coupee
 190 c====
 191 c
 192       indtri = indtri + 1
 193       iaux = iaux + 1
 194       triint(iaux) = indtri
 195       call cmctri ( aretri, famtri, hettri,
 196      >              filtri, pertri, nivtri,
 197      >              indtri, lesare(iaux), areint(6), areint(3),
 198      >              codetr, niveau )
 199 c
 200       iaux = iaux + 1
 201       indtri = indtri + 1
 202       triint(iaux) = indtri
 203       call cmctri ( aretri, famtri, hettri,
 204      >              filtri, pertri, nivtri,
 205      >              indtri, lesare(iaux), areint(2), areint(5),
 206      >              codetr, niveau )
 207 c
 208       iaux = iaux + 1
 209       indtri = indtri + 1
 210       triint(iaux) = indtri
 211       call cmctri ( aretri, famtri, hettri,
 212      >              filtri, pertri, nivtri,
 213      >              indtri, lesare(iaux), areint(4), areint(1),
 214      >              codetr, niveau )
 215 c
 216 c====
 217 c 4. 10-21 : les triangles s'appuyant sur les aretes tracees
 218 c    sur les faces coupees
 219 c    on les range face par face, et dans une face, sommet par sommet
 220 c====
 221 c
 222       jaux = 1
 223 c face 1, cote du sommet 1
 224       iaux = iaux + 1
 225       indtri = indtri + 1
 226       triint(iaux) = indtri
 227       call cmctri ( aretri, famtri, hettri,
 228      >              filtri, pertri, nivtri,
 229      >              indtri, areqtr(jaux,1), areint(9),
 230      >                                      areint(7),
 231      >              codetr, niveau )
 232 c face 1, autre cote
 233       iaux = iaux + 1
 234       indtri = indtri + 1
 235       triint(iaux) = indtri
 236       call cmctri ( aretri, famtri, hettri,
 237      >              filtri, pertri, nivtri,
 238      >              indtri, areqtr(jaux,2), areint(5),
 239      >                                      areint(9),
 240      >              codetr, niveau )
 241 c
 242 c face 2, cote du sommet 1
 243       jaux = 2
 244       iaux = iaux + 1
 245       indtri = indtri + 1
 246       triint(iaux) = indtri
 247       call cmctri ( aretri, famtri, hettri,
 248      >              filtri, pertri, nivtri,
 249      >              indtri, areqtr(jaux,1), areint(4),
 250      >                                      areint(9),
 251      >              codetr, niveau )
 252 c face 2, autre cote
 253       iaux = iaux + 1
 254       indtri = indtri + 1
 255       triint(iaux) = indtri
 256       call cmctri ( aretri, famtri, hettri,
 257      >              filtri, pertri, nivtri,
 258      >              indtri, areqtr(jaux,2), areint(9),
 259      >                                      areint(8),
 260      >              codetr, niveau )
 261 c
 262 c face 3, cote du sommet 3
 263       jaux = 3
 264       iaux = iaux + 1
 265       indtri = indtri + 1
 266       triint(iaux) = indtri
 267       call cmctri ( aretri, famtri, hettri,
 268      >              filtri, pertri, nivtri,
 269      >              indtri, areqtr(jaux,1), areint(10),
 270      >                                      areint(7),
 271      >              codetr, niveau )
 272 c face 3, autre cote
 273       iaux = iaux + 1
 274       indtri = indtri + 1
 275       triint(iaux) = indtri
 276       call cmctri ( aretri, famtri, hettri,
 277      >              filtri, pertri, nivtri,
 278      >              indtri, areqtr(jaux,2), areint(1),
 279      >                                      areint(10),
 280      >              codetr, niveau )
 281 c
 282 c face 4, cote du sommet 3
 283       jaux = 4
 284       iaux = iaux + 1
 285       indtri = indtri + 1
 286       triint(iaux) = indtri
 287       call cmctri ( aretri, famtri, hettri,
 288      >              filtri, pertri, nivtri,
 289      >              indtri, areqtr(jaux,1), areint(6),
 290      >                                      areint(10),
 291      >              codetr, niveau )
 292 c face 4, autre cote
 293       iaux = iaux + 1
 294       indtri = indtri + 1
 295       triint(iaux) = indtri
 296       call cmctri ( aretri, famtri, hettri,
 297      >              filtri, pertri, nivtri,
 298      >              indtri, areqtr(jaux,2), areint(10),
 299      >                                      areint(8),
 300      >              codetr, niveau )
 301 c
 302 c face 5, cote du sommet 5
 303       jaux = 5
 304       iaux = iaux + 1
 305       indtri = indtri + 1
 306       triint(iaux) = indtri
 307       call cmctri ( aretri, famtri, hettri,
 308      >              filtri, pertri, nivtri,
 309      >              indtri, areqtr(jaux,1), areint(11),
 310      >                                      areint(7),
 311      >              codetr, niveau )
 312 c face 5, autre cote
 313       iaux = iaux + 1
 314       indtri = indtri + 1
 315       triint(iaux) = indtri
 316       call cmctri ( aretri, famtri, hettri,
 317      >              filtri, pertri, nivtri,
 318      >              indtri, areqtr(jaux,2), areint(3),
 319      >                                      areint(11),
 320      >              codetr, niveau )
 321 c
 322 c face 6, cote du sommet 5
 323       jaux = 6
 324       iaux = iaux + 1
 325       indtri = indtri + 1
 326       triint(iaux) = indtri
 327       call cmctri ( aretri, famtri, hettri,
 328      >              filtri, pertri, nivtri,
 329      >              indtri, areqtr(jaux,1), areint(2),
 330      >                                      areint(11),
 331      >              codetr, niveau )
 332 c face 6, autre cote
 333       iaux = iaux + 1
 334       indtri = indtri + 1
 335       triint(iaux) = indtri
 336       call cmctri ( aretri, famtri, hettri,
 337      >              filtri, pertri, nivtri,
 338      >              indtri, areqtr(jaux,2), areint(11),
 339      >                                      areint(8),
 340      >              codetr, niveau )
 341 c
 342 c====
 343 c 5. 22-27 : les triangles s'appuyant sur les filles des aretes coupees
 344 c    . jaux represente la boucle sur les aretes coupees
 345 c    . aretri(trifad(2*jaux,1),i) : la i-eme fille de l'arete coupee
 346 c    . areint(8+jaux) : l'arete entre le noeud de l'arete coupee et
 347 c                       le centre de l'hexaedre
 348 c    . areint(2*jaux-1) : l'arete entre le sommet 1 de l'arete coupee et
 349 c                         le centre de l'hexaedre
 350 c    . areint(2*jaux  ) : l'arete entre le sommet 2 de l'arete coupee et
 351 c                         le centre de l'hexaedre
 352 c====
 353 c
 354       iaux = iaux + 1
 355       indtri = indtri + 1
 356       triint(iaux) = indtri
 357       call cmctri ( aretri, famtri, hettri,
 358      >              filtri, pertri, nivtri,
 359      >              indtri, aretri(trifad(2,1),1),
 360      >              areint(1), areint(9),
 361      >              codetr, niveau )
 362 c
 363       iaux = iaux + 1
 364       indtri = indtri + 1
 365       triint(iaux) = indtri
 366       call cmctri ( aretri, famtri, hettri,
 367      >              filtri, pertri, nivtri,
 368      >              indtri, aretri(trifad(2,2),1),
 369      >              areint(9), areint(2),
 370      >              codetr, niveau )
 371 c
 372       iaux = iaux + 1
 373       indtri = indtri + 1
 374       triint(iaux) = indtri
 375       call cmctri ( aretri, famtri, hettri,
 376      >              filtri, pertri, nivtri,
 377      >              indtri, aretri(trifad(4,1),1),
 378      >              areint(3), areint(10),
 379      >              codetr, niveau )
 380 c
 381       iaux = iaux + 1
 382       indtri = indtri + 1
 383       triint(iaux) = indtri
 384       call cmctri ( aretri, famtri, hettri,
 385      >              filtri, pertri, nivtri,
 386      >              indtri, aretri(trifad(4,2),1),
 387      >              areint(10), areint(4),
 388      >              codetr, niveau )
 389 c
 390       iaux = iaux + 1
 391       indtri = indtri + 1
 392       triint(iaux) = indtri
 393       call cmctri ( aretri, famtri, hettri,
 394      >              filtri, pertri, nivtri,
 395      >              indtri, aretri(trifad(6,1),1),
 396      >              areint(5), areint(11),
 397      >              codetr, niveau )
 398 c
 399       iaux = iaux + 1
 400       indtri = indtri + 1
 401       triint(iaux) = indtri
 402       call cmctri ( aretri, famtri, hettri,
 403      >              filtri, pertri, nivtri,
 404      >              indtri, aretri(trifad(6,2),1),
 405      >              areint(11), areint(6),
 406      >              codetr, niveau )
 407 c
 408 #ifdef _DEBUG_HOMARD_
 409       do 5555 , iaux = 1, 27
 410       write(ulsort,1789) iaux, triint(iaux),
 411      >                   ' a1 ',aretri(triint(iaux),1),
 412      >                   ' a2 ',aretri(triint(iaux),2),
 413      >                   ' a3 ',aretri(triint(iaux),3)
 414       if ( iaux.eq.6 .or. iaux.eq.9 .or. iaux.eq.21 ) then
 415       write(ulsort,*)' '
 416       endif
 417  5555 continue
 418  1789 format('triint(',i2,') = ',i6,' : ',5(a,'=',i6,','))
 419 #endif
 420 c
 421 c===
 422 c 6. la fin
 423 c====
 424 c
 425       if ( codret.ne.0 ) then
 426 c
 427 #include "envex2.h"
 428 c
 429       write (ulsort,texte(langue,1)) 'Sortie', nompro
 430       write (ulsort,texte(langue,2)) codret
 431 c
 432       endif
 433 c
 434 #ifdef _DEBUG_HOMARD_
 435       write (ulsort,texte(langue,1)) 'Sortie', nompro
 436       call dmflsh (iaux)
 437 #endif
 438 c
 439       end