src/tool/Utilitaire/utincg.F

   1       subroutine utincg
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c    UTilitaire - INitialisation des Constantes Generales
  23 c    --           --                 -          -
  24 c ______________________________________________________________________
  25 c
  26 c====
  27 c 0. declarations et dimensionnement
  28 c====
  29 c
  30 c 0.1. ==> generalites
  31 c
  32       implicit none
  33       save
  34 c
  35 c 0.2. ==> communs
  36 c
  37 #include "i1i2i3.h"
  38 #include "j1234j.h"
  39 #include "defiqu.h"
  40 #include "demitr.h"
  41 #include "comp07.h"
  42 #include "op0012.h"
  43 #include "op0123.h"
  44 #include "op1234.h"
  45 #include "oriett.h"
  46 #include "orieqh.h"
  47 #include "oriefp.h"
  48 #include "oriefy.h"
  49 #include "op1aa6.h"
  50 #include "ope1a3.h"
  51 #include "ope1a4.h"
  52 #include "ope4a6.h"
  53 #include "ope001.h"
  54 #include "ope002.h"
  55 #include "infini.h"
  56 #include "impr02.h"
  57 #include "enti01.h"
  58 #include "indefi.h"
  59 #include "indefr.h"
  60 #include "indefs.h"
  61 #include "precis.h"
  62 #include "chisig.h"
  63 #include "hexcf0.h"
  64 #include "hexcf1.h"
  65 #include "dicfen.h"
  66 #include "nbfamm.h"
  67 c
  68 #include "fahmed.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer iaux, jaux
  75       integer kaux1, kaux2, kaux3, kaux4
  76       integer tabaux(6)
  77       integer typenh
  78 c
  79 #include "impr03.h"
  80 c
  81 c====
  82 c 1. les constantes
  83 c====
  84 c
  85 c 1.1. ==> les extremes
  86 c
  87       call dmzero ( vinfpo, zeroma )
  88 c
  89       vinfne = - vinfpo
  90 c
  91 c 1.2. ==> precision machine et plus grand entier
  92 c
  93       call dmprma ( epsima, dmxent, nbchii )
  94 c
  95 c 1.3. ==> les valeurs indefinies
  96 c
  97       call dmindf ( iindef, rindef, sindef )
  98 c
  99 c====
 100 c 2. initialisation des fonctions en dur
 101 c====
 102 c
 103 c 2.1. ==> fonction de numerotation des demi-triangles fils
 104 c      remarque :  la diagonale du tableau n'est pas utilisee
 105 c                  on met une valeur indefinie pour planter au cas ou !
 106 c
 107       nutrde(1,1) = iindef
 108       nutrde(1,2) = 0
 109       nutrde(1,3) = 1
 110       nutrde(2,1) = 0
 111       nutrde(2,2) = iindef
 112       nutrde(2,3) = 1
 113       nutrde(3,1) = 0
 114       nutrde(3,2) = 1
 115       nutrde(3,3) = iindef
 116 c
 117 c 2.2. ==> Codes permettant d'ordonner les fils d'un quadrangle
 118 c          quand il est face d'un hexaedre ou d'un pentaedre
 119 c
 120       defiq1(1) = 0
 121       defiq1(2) = 3
 122       defiq1(3) = 2
 123       defiq1(4) = 1
 124       defiq1(5) = 1
 125       defiq1(6) = 2
 126       defiq1(7) = 3
 127       defiq1(8) = 0
 128 c
 129       defiq2(1) = 1
 130       defiq2(2) = 0
 131       defiq2(3) = 3
 132       defiq2(4) = 2
 133       defiq2(5) = 0
 134       defiq2(6) = 1
 135       defiq2(7) = 2
 136       defiq2(8) = 3
 137 c
 138       defiq3(1) = 2
 139       defiq3(2) = 1
 140       defiq3(3) = 0
 141       defiq3(4) = 3
 142       defiq3(5) = 3
 143       defiq3(6) = 0
 144       defiq3(7) = 1
 145       defiq3(8) = 2
 146 c
 147       defiq4(1) = 3
 148       defiq4(2) = 2
 149       defiq4(3) = 1
 150       defiq4(4) = 0
 151       defiq4(5) = 2
 152       defiq4(6) = 3
 153       defiq4(7) = 0
 154       defiq4(8) = 1
 155 c
 156 c 2.3. ==> numero local de la face opposee pour un hexaedre respectant
 157 c          la convention d'un de : i + coen07(i) = 7
 158 c
 159       coen07(1) = 6
 160       coen07(2) = 5
 161       coen07(3) = 4
 162       coen07(4) = 3
 163       coen07(5) = 2
 164       coen07(6) = 1
 165 c
 166 c 2.4. ==> correspondance entre le code d'un triangle dans un
 167 c          tetraedre ou un pentaedre et les numeros locaux des aretes
 168 c          de cette face
 169 c          Pour une face de code c :
 170 c           i1(c) : numero local de l'arete I1
 171 c           i2(c) : numero local de l'arete I2
 172 c           i3(c) : numero local de l'arete I3
 173 c
 174       i1(1) = 1
 175       i1(2) = 3
 176       i1(3) = 2
 177       i1(4) = 1
 178       i1(5) = 3
 179       i1(6) = 2
 180 c
 181       i2(1) = 2
 182       i2(2) = 1
 183       i2(3) = 3
 184       i2(4) = 3
 185       i2(5) = 2
 186       i2(6) = 1
 187 c
 188       i3(1) = 3
 189       i3(2) = 2
 190       i3(3) = 1
 191       i3(4) = 2
 192       i3(5) = 1
 193       i3(6) = 3
 194 c
 195 c 2.5. ==> correspondance entre le code d'un quadrangle dans un
 196 c          un hexaedre ou un pentaedre et les numeros locaux des aretes
 197 c          de cette face
 198 c          Pour une face de code c :
 199 c           j1(c) : numero local de l'arete I1
 200 c           j2(c) : numero local de l'arete I2
 201 c           j3(c) : numero local de l'arete I3
 202 c           j4(c) : numero local de l'arete I4
 203 c
 204       j1(1) = 1
 205       j1(2) = 4
 206       j1(3) = 3
 207       j1(4) = 2
 208       j1(5) = 1
 209       j1(6) = 2
 210       j1(7) = 3
 211       j1(8) = 4
 212 c
 213       j2(1) = 2
 214       j2(2) = 1
 215       j2(3) = 4
 216       j2(4) = 3
 217       j2(5) = 4
 218       j2(6) = 1
 219       j2(7) = 2
 220       j2(8) = 3
 221 c
 222       j3(1) = 3
 223       j3(2) = 2
 224       j3(3) = 1
 225       j3(4) = 4
 226       j3(5) = 3
 227       j3(6) = 4
 228       j3(7) = 1
 229       j3(8) = 2
 230 c
 231       j4(1) = 4
 232       j4(2) = 3
 233       j4(3) = 2
 234       j4(4) = 1
 235       j4(5) = 2
 236       j4(6) = 3
 237       j4(7) = 4
 238       j4(8) = 1
 239 c
 240 c 2.6. ==> correspondance entre le code des faces dans un volume
 241 c          et l'orientation relative de cette face
 242 c          Pour la face i de code c :
 243 c            orcoxx(i,c) :  1, la face est sortante
 244 c                          -1, la face est entrante
 245 c 2.6.1. ==> tetraedre/triangle
 246 c
 247       orcott(1,1) =  1
 248       orcott(1,2) =  1
 249       orcott(1,3) =  1
 250       orcott(1,4) = -1
 251       orcott(1,5) = -1
 252       orcott(1,6) = -1
 253 c
 254       orcott(2,1) = -1
 255       orcott(2,2) = -1
 256       orcott(2,3) = -1
 257       orcott(2,4) =  1
 258       orcott(2,5) =  1
 259       orcott(2,6) =  1
 260 c
 261       orcott(3,1) = -1
 262       orcott(3,2) = -1
 263       orcott(3,3) = -1
 264       orcott(3,4) =  1
 265       orcott(3,5) =  1
 266       orcott(3,6) =  1
 267 c
 268       orcott(4,1) =  1
 269       orcott(4,2) =  1
 270       orcott(4,3) =  1
 271       orcott(4,4) = -1
 272       orcott(4,5) = -1
 273       orcott(4,6) = -1
 274 c
 275 c 2.6.3. ==> hexaedre/quadrangle
 276 c
 277       orcoqh(1,1) = -1
 278       orcoqh(1,2) = -1
 279       orcoqh(1,3) = -1
 280       orcoqh(1,4) = -1
 281       orcoqh(1,5) =  1
 282       orcoqh(1,6) =  1
 283       orcoqh(1,7) =  1
 284       orcoqh(1,8) =  1
 285 c
 286       orcoqh(2,1) = -1
 287       orcoqh(2,2) = -1
 288       orcoqh(2,3) = -1
 289       orcoqh(2,4) = -1
 290       orcoqh(2,5) =  1
 291       orcoqh(2,6) =  1
 292       orcoqh(2,7) =  1
 293       orcoqh(2,8) =  1
 294 c
 295       orcoqh(3,1) = -1
 296       orcoqh(3,2) = -1
 297       orcoqh(3,3) = -1
 298       orcoqh(3,4) = -1
 299       orcoqh(3,5) =  1
 300       orcoqh(3,6) =  1
 301       orcoqh(3,7) =  1
 302       orcoqh(3,8) =  1
 303 c
 304       orcoqh(4,1) = -1
 305       orcoqh(4,2) = -1
 306       orcoqh(4,3) = -1
 307       orcoqh(4,4) = -1
 308       orcoqh(4,5) =  1
 309       orcoqh(4,6) =  1
 310       orcoqh(4,7) =  1
 311       orcoqh(4,8) =  1
 312 c
 313       orcoqh(5,1) = -1
 314       orcoqh(5,2) = -1
 315       orcoqh(5,3) = -1
 316       orcoqh(5,4) = -1
 317       orcoqh(5,5) =  1
 318       orcoqh(5,6) =  1
 319       orcoqh(5,7) =  1
 320       orcoqh(5,8) =  1
 321 c
 322       orcoqh(6,1) = -1
 323       orcoqh(6,2) = -1
 324       orcoqh(6,3) = -1
 325       orcoqh(6,4) = -1
 326       orcoqh(6,5) =  1
 327       orcoqh(6,6) =  1
 328       orcoqh(6,7) =  1
 329       orcoqh(6,8) =  1
 330 c
 331 c 2.6.3. ==> pentaedre/triangle et pentaedre/quadrangle
 332 c
 333       orcofp(1,1) = -1
 334       orcofp(1,2) = -1
 335       orcofp(1,3) = -1
 336       orcofp(1,4) =  1
 337       orcofp(1,5) =  1
 338       orcofp(1,6) =  1
 339 c
 340       orcofp(2,1) = -1
 341       orcofp(2,2) = -1
 342       orcofp(2,3) = -1
 343       orcofp(2,4) =  1
 344       orcofp(2,5) =  1
 345       orcofp(2,6) =  1
 346 c
 347       orcofp(3,1) = -1
 348       orcofp(3,2) = -1
 349       orcofp(3,3) = -1
 350       orcofp(3,4) = -1
 351       orcofp(3,5) =  1
 352       orcofp(3,6) =  1
 353       orcofp(3,7) =  1
 354       orcofp(3,8) =  1
 355 c
 356       orcofp(4,1) = -1
 357       orcofp(4,2) = -1
 358       orcofp(4,3) = -1
 359       orcofp(4,4) = -1
 360       orcofp(4,5) =  1
 361       orcofp(4,6) =  1
 362       orcofp(4,7) =  1
 363       orcofp(4,8) =  1
 364 c
 365       orcofp(5,1) = -1
 366       orcofp(5,2) = -1
 367       orcofp(5,3) = -1
 368       orcofp(5,4) = -1
 369       orcofp(5,5) =  1
 370       orcofp(5,6) =  1
 371       orcofp(5,7) =  1
 372       orcofp(5,8) =  1
 373 c
 374 c 2.6.4. ==> pyramide/triangle et pyramide/quadrangle
 375 c
 376       orcofy(1,1) = -1
 377       orcofy(1,2) = -1
 378       orcofy(1,3) = -1
 379       orcofy(1,4) =  1
 380       orcofy(1,5) =  1
 381       orcofy(1,6) =  1
 382 c
 383       orcofy(2,1) = -1
 384       orcofy(2,2) = -1
 385       orcofy(2,3) = -1
 386       orcofy(2,4) =  1
 387       orcofy(2,5) =  1
 388       orcofy(2,6) =  1
 389 c
 390       orcofy(3,1) = -1
 391       orcofy(3,2) = -1
 392       orcofy(3,3) = -1
 393       orcofy(3,4) =  1
 394       orcofy(3,5) =  1
 395       orcofy(3,6) =  1
 396 c
 397       orcofy(4,1) = -1
 398       orcofy(4,2) = -1
 399       orcofy(4,3) = -1
 400       orcofy(4,4) =  1
 401       orcofy(4,5) =  1
 402       orcofy(4,6) =  1
 403 c
 404       orcofy(5,1) = -1
 405       orcofy(5,2) = -1
 406       orcofy(5,3) = -1
 407       orcofy(5,4) = -1
 408       orcofy(5,5) =  1
 409       orcofy(5,6) =  1
 410       orcofy(5,7) =  1
 411       orcofy(5,8) =  1
 412 c
 413 c====
 414 c 3. manipulations numeriques
 415 c====
 416 c 3.1. ==> choix du 2nd chiffre entre 1 et 2
 417 c
 418       fp0012(1) = 2
 419       fp0012(2) = 1
 420 c
 421 c 3.2. ==> choix du 3eme chiffre entre 1, 2 et 3
 422 c
 423       fp0123(1,1) = iindef
 424       fp0123(1,2) = 3
 425       fp0123(1,3) = 2
 426       fp0123(2,1) = 3
 427       fp0123(2,2) = iindef
 428       fp0123(2,3) = 1
 429       fp0123(3,1) = 2
 430       fp0123(3,2) = 1
 431       fp0123(3,3) = iindef
 432 c
 433 c 3.3. ==> choix du 4eme chiffre entre 1, 2, 3 et 4
 434 c
 435       do 33 , iaux = 1 , 4
 436         do 331 , jaux = 1 , 4
 437           do 3311 , kaux1 = 1 , 4
 438             tabaux(kaux1) = 0
 439  3311     continue
 440           tabaux(iaux) = 1
 441           tabaux(jaux) = 1
 442           do 3312 , kaux1 = 1 , 4
 443             if ( iaux.eq.jaux .or. jaux.eq.kaux1 .or.
 444      >           kaux1.eq.iaux ) then
 445               fp1234(iaux,jaux,kaux1) = iindef
 446             else
 447               do 3313 , kaux2 = 1 , 4
 448                 if ( tabaux(kaux2).eq.0 .and. kaux2.ne.kaux1 ) then
 449                   fp1234(iaux,jaux,kaux1) = kaux2
 450                 endif
 451  3313         continue
 452             endif
 453  3312     continue
 454   331   continue
 455    33 continue
 456 c
 457 c 3.4. ==> choix du 6eme chiffre entre 1, 2, 3, 4, 5 et 6
 458 c
 459       do 34 , iaux = 1 , 6
 460         do 341 , jaux = 1 , 6
 461           do 3411 , kaux1 = 1 , 6
 462             do 3412 , kaux2 = 1 , 6
 463               do 3413 , kaux3 = 1 , 6
 464                 tabaux(kaux3) = 0
 465  3413         continue
 466               tabaux(iaux) = 1
 467               tabaux(jaux) = 1
 468               tabaux(kaux1) = 1
 469               tabaux(kaux2) = 1
 470               do 3414 , kaux3 = 1 , 6
 471                 if ( iaux.eq.jaux .or. iaux.eq.kaux1 .or.
 472      >               iaux.eq.kaux2 .or. jaux.eq.kaux1 .or.
 473      >               jaux.eq.kaux2 .or. kaux1.eq.kaux2 ) then
 474                   fp1aa6(iaux,jaux,kaux1,kaux2,kaux3) = iindef
 475                 else
 476                   do 3415 , kaux4 = 1 , 6
 477                     if ( tabaux(kaux4).eq.0 .and. kaux4.ne.kaux3 ) then
 478                       fp1aa6(iaux,jaux,kaux1,kaux2,kaux3) = kaux4
 479                     endif
 480  3415             continue
 481                 endif
 482  3414         continue
 483  3412       continue
 484  3411     continue
 485   341   continue
 486    34 continue
 487 c
 488 c 3.5. ==> dans la permutation circulaire (1,2,3) :
 489 c          per1a3(-1,i) renvoie l'entier qui est avant i
 490 c          per1a3( 0,i) renvoie l'entier i
 491 c          per1a3( 1,i) renvoie l'entier qui est apres i
 492 c          per1a3( 2,i) renvoie l'entier qui est 2 places apres i
 493 c
 494       per1a3(-1,1) = 3
 495       per1a3(-1,2) = 1
 496       per1a3(-1,3) = 2
 497 c
 498       per1a3( 0,1) = 1
 499       per1a3( 0,2) = 2
 500       per1a3( 0,3) = 3
 501 c
 502       per1a3( 1,1) = 2
 503       per1a3( 1,2) = 3
 504       per1a3( 1,3) = 1
 505 c
 506       per1a3( 2,1) = 3
 507       per1a3( 2,2) = 1
 508       per1a3( 2,3) = 2
 509 c
 510 c 3.6. ==> dans la permutation circulaire (1,2,3,4) :
 511 c          . Pour i de 1 a 4 :
 512 c            per1a4(-5,i) = 1 devient 2, puis sens inverse
 513 c            per1a4(-4,i) = 1 devient 3, puis sens inverse
 514 c            per1a4(-3,i) = 1 devient 4, puis sens inverse
 515 c            per1a4(-2,i) = 1 idem, puis sens inverse
 516 c            per1a4(-1,i) renvoie l'entier qui est avant i
 517 c            per1a4( 0,i) renvoie l'entier i
 518 c            per1a4( 1,i) renvoie l'entier qui est apres i
 519 c            per1a4( 2,i) renvoie l'entier qui est 2 places apres i
 520 c            per1a4( 3,i) renvoie l'entier qui est 3 places apres i
 521 c          . Pour i =5 :
 522 c            per1a4(j,5) = le reciproque de per1a4(j,*)
 523 c
 524       per1a4(-5,1) = 2
 525       per1a4(-5,2) = 1
 526       per1a4(-5,3) = 4
 527       per1a4(-5,4) = 3
 528       per1a4(-5,5) = -5
 529 c
 530       per1a4(-4,1) = 3
 531       per1a4(-4,2) = 2
 532       per1a4(-4,3) = 1
 533       per1a4(-4,4) = 4
 534       per1a4(-4,5) = -4
 535 c
 536       per1a4(-3,1) = 4
 537       per1a4(-3,2) = 3
 538       per1a4(-3,3) = 2
 539       per1a4(-3,4) = 1
 540       per1a4(-3,5) = -3
 541 c
 542       per1a4(-2,1) = 1
 543       per1a4(-2,2) = 4
 544       per1a4(-2,3) = 3
 545       per1a4(-2,4) = 2
 546       per1a4(-2,5) = -2
 547 c
 548       per1a4(-1,1) = 4
 549       per1a4(-1,2) = 1
 550       per1a4(-1,3) = 2
 551       per1a4(-1,4) = 3
 552       per1a4(-1,5) = 3
 553 c
 554       per1a4( 0,1) = 1
 555       per1a4( 0,2) = 2
 556       per1a4( 0,3) = 3
 557       per1a4( 0,4) = 4
 558       per1a4( 0,5) = 0
 559 c
 560       per1a4( 1,1) = 2
 561       per1a4( 1,2) = 3
 562       per1a4( 1,3) = 4
 563       per1a4( 1,4) = 1
 564       per1a4( 1,5) = -1
 565 c
 566       per1a4( 2,1) = 3
 567       per1a4( 2,2) = 4
 568       per1a4( 2,3) = 1
 569       per1a4( 2,4) = 2
 570       per1a4( 2,5) = 2
 571 c
 572       per1a4( 3,1) = 4
 573       per1a4( 3,2) = 1
 574       per1a4( 3,3) = 2
 575       per1a4( 3,4) = 3
 576       per1a4( 3,5) = 1
 577 c
 578 c 3.7. ==> dans la permutation circulaire (4,5,6) :
 579 c          per4a6(-1,i) = entier avant i
 580 c          per4a6( 0,i) = i
 581 c          per4a6( 1,i) = entier apres i
 582 c          per4a6( 2,i) = entier 2 places apres i = per4a6(-1,i)
 583 c
 584       per4a6(-1,4) = 6
 585       per4a6(-1,5) = 4
 586       per4a6(-1,6) = 5
 587 c
 588       per4a6( 0,4) = 4
 589       per4a6( 0,5) = 5
 590       per4a6( 0,6) = 6
 591 c
 592       per4a6( 1,4) = 5
 593       per4a6( 1,5) = 6
 594       per4a6( 1,6) = 4
 595 c
 596       per4a6( 2,4) = 6
 597       per4a6( 2,5) = 4
 598       per4a6( 2,6) = 5
 599 c
 600 c 3.8. ==> per001 : etablissement des codes pour les raffinements
 601 c                   conformes des pentaedres
 602 c     remarque : per001(i,1) = i
 603 c
 604       per001(1,1) = 1
 605       per001(1,2) = 2
 606       per001(1,3) = 3
 607       per001(1,4) = 4
 608       per001(1,5) = 5
 609       per001(1,6) = 6
 610 c
 611       per001(2,1) = 2
 612       per001(2,2) = 3
 613       per001(2,3) = 1
 614       per001(2,4) = 6
 615       per001(2,5) = 4
 616       per001(2,6) = 5
 617 c
 618       per001(3,1) = 3
 619       per001(3,2) = 1
 620       per001(3,3) = 2
 621       per001(3,4) = 5
 622       per001(3,5) = 6
 623       per001(3,6) = 4
 624 c
 625       per001(4,1) = 4
 626       per001(4,2) = 5
 627       per001(4,3) = 6
 628       per001(4,4) = 1
 629       per001(4,5) = 2
 630       per001(4,6) = 3
 631 c
 632       per001(5,1) = 5
 633       per001(5,2) = 6
 634       per001(5,3) = 4
 635       per001(5,4) = 3
 636       per001(5,5) = 1
 637       per001(5,6) = 2
 638 c
 639       per001(6,1) = 6
 640       per001(6,2) = 4
 641       per001(6,3) = 5
 642       per001(6,4) = 2
 643       per001(6,5) = 3
 644       per001(6,6) = 1
 645 c
 646 c 3.9. ==> per002 : permutation circulaire des 8 permiers entiers,
 647 c                   traites par paquet de 4
 648 c     remarque : per002(i,1) = i
 649 c
 650       per002(1,1) = 1
 651       per002(1,2) = 2
 652       per002(1,3) = 3
 653       per002(1,4) = 4
 654       per002(1,5) = 5
 655       per002(1,6) = 6
 656       per002(1,7) = 7
 657       per002(1,8) = 8
 658 c
 659       per002(2,1) = 2
 660       per002(2,2) = 3
 661       per002(2,3) = 4
 662       per002(2,4) = 1
 663       per002(2,5) = 6
 664       per002(2,6) = 7
 665       per002(2,7) = 8
 666       per002(2,8) = 5
 667 c
 668       per002(3,1) = 3
 669       per002(3,2) = 4
 670       per002(3,3) = 1
 671       per002(3,4) = 2
 672       per002(3,5) = 7
 673       per002(3,6) = 8
 674       per002(3,7) = 5
 675       per002(3,8) = 6
 676 c
 677       per002(4,1) = 4
 678       per002(4,2) = 1
 679       per002(4,3) = 2
 680       per002(4,4) = 3
 681       per002(4,5) = 8
 682       per002(4,6) = 5
 683       per002(4,7) = 6
 684       per002(4,8) = 7
 685 c
 686 c====
 687 c 4. description pour une connectivite a la med
 688 c====
 689 c
 690 c 4.1. ==> prealable
 691 c
 692       do 41 , iaux = 0 , 7
 693         do 411 , jaux = 1 , 6
 694           nofmed(iaux,jaux,1) = iindef
 695           nofmed(iaux,jaux,2) = iindef
 696           nofmed(iaux,jaux,3) = iindef
 697   411   continue
 698    41 continue
 699 c
 700 c 4.2. ==> tetraedre
 701 c
 702       typenh = 3
 703       nofmed(typenh,1,1) = 1
 704       nofmed(typenh,2,1) = 2
 705       nofmed(typenh,3,1) = 3
 706       nofmed(typenh,4,1) = 4
 707 c
 708       do 42 , jaux = 1 , 4
 709         iaux = nofmed(typenh,jaux,1)
 710         nofmed(typenh,iaux,2) = jaux
 711    42 continue
 712 cgn      print *,(nofmed(typenh,jaux,2),jaux = 1 , 4)
 713 c
 714 c 4.3. ==> hexaedre
 715 c
 716       typenh = 6
 717       nofmed(typenh,1,1) = 1
 718       nofmed(typenh,2,1) = 6
 719       nofmed(typenh,3,1) = 2
 720       nofmed(typenh,4,1) = 4
 721       nofmed(typenh,5,1) = 5
 722       nofmed(typenh,6,1) = 3
 723 c
 724       do 43 , jaux = 1 , 6
 725         iaux = nofmed(typenh,jaux,1)
 726         nofmed(typenh,iaux,2) = jaux
 727    43 continue
 728 cgn      print *,(nofmed(typenh,jaux,2),jaux = 1 , 6)
 729 c
 730 c 4.4. ==> pentaedre
 731 c
 732       typenh = 7
 733       nofmed(typenh,1,1) = 1
 734       nofmed(typenh,2,1) = 2
 735       nofmed(typenh,3,1) = 3
 736       nofmed(typenh,4,1) = 4
 737       nofmed(typenh,5,1) = 5
 738 c
 739       do 44 , jaux = 1 , 5
 740         iaux = nofmed(typenh,jaux,1)
 741         nofmed(typenh,iaux,2) = jaux
 742    44 continue
 743 cgn      print *,(nofmed(typenh,jaux,2),jaux = 1 , 5)
 744
 745 c 4.5. ==> pyramide
 746 c
 747       typenh = 5
 748       nofmed(typenh,1,1) = 5
 749       nofmed(typenh,2,1) = 1
 750       nofmed(typenh,3,1) = 2
 751       nofmed(typenh,4,1) = 3
 752       nofmed(typenh,5,1) = 4
 753 c
 754       do 45 , jaux = 1 , 5
 755         iaux = nofmed(typenh,jaux,1)
 756         nofmed(typenh,iaux,2) = jaux
 757    45 continue
 758 cgn      print *,(nofmed(typenh,jaux,2),jaux = 1 , 5)
 759 c
 760 c====
 761 c 5. messages
 762 c    remarque : le code doit etre le meme que pour suffix
 763 c====
 764 c
 765 c                       12345678901234
 766       mess14(1,1,-1) = 'noeud         '
 767       mess14(1,1,0)  = 'maille-point  '
 768       mess14(1,1,1)  = 'segment       '
 769       mess14(1,1,2)  = 'triangle      '
 770       mess14(1,1,3)  = 'tetraedre     '
 771       mess14(1,1,4)  = 'quadrangle    '
 772       mess14(1,1,5)  = 'pyramide      '
 773       mess14(1,1,6)  = 'hexaedre      '
 774       mess14(1,1,7)  = 'pentaedre     '
 775       mess14(1,1,8)  = 'face          '
 776       mess14(1,1,9)  = 'volume        '
 777       mess14(1,1,10) = '  entite      '
 778       mess14(1,1,11) = 'provisoire    '
 779       mess14(1,1,12) = 'sans objet    '
 780       mess14(1,1,13) = 'maille        '
 781 c
 782       mess14(1,2,-1) = 'Noeud         '
 783       mess14(1,2,0)  = 'Maille-Point  '
 784       mess14(1,2,1)  = 'Segment       '
 785       mess14(1,2,2)  = 'Triangle      '
 786       mess14(1,2,3)  = 'Tetraedre     '
 787       mess14(1,2,4)  = 'Quadrangle    '
 788       mess14(1,2,5)  = 'Pyramide      '
 789       mess14(1,2,6)  = 'Hexaedre      '
 790       mess14(1,2,7)  = 'Pentaedre     '
 791       mess14(1,2,8)  = 'Face          '
 792       mess14(1,2,9)  = 'Volume        '
 793       mess14(1,2,10) = '  Entite      '
 794       mess14(1,2,11) = 'Provisoire    '
 795       mess14(1,2,12) = 'Sans objet    '
 796       mess14(1,2,13) = 'Maille        '
 797 c
 798       mess14(1,3,-1) = 'noeuds        '
 799       mess14(1,3,0)  = 'mailles-points'
 800       mess14(1,3,1)  = 'segments      '
 801       mess14(1,3,2)  = 'triangles     '
 802       mess14(1,3,3)  = 'tetraedres    '
 803       mess14(1,3,4)  = 'quadrangles   '
 804       mess14(1,3,5)  = 'pyramides     '
 805       mess14(1,3,6)  = 'hexaedres     '
 806       mess14(1,3,7)  = 'pentaedres    '
 807       mess14(1,3,8)  = 'faces         '
 808       mess14(1,3,9)  = 'volumes       '
 809       mess14(1,3,10) = 'entites       '
 810       mess14(1,3,11) = 'Provisoire    '
 811       mess14(1,3,12) = 'Sans objet    '
 812       mess14(1,3,13) = 'mailles       '
 813 c
 814       mess14(1,4,-1) = 'Noeuds        '
 815       mess14(1,4,0)  = 'Mailles-Points'
 816       mess14(1,4,1)  = 'Segments      '
 817       mess14(1,4,2)  = 'Triangles     '
 818       mess14(1,4,3)  = 'Tetraedres    '
 819       mess14(1,4,4)  = 'Quadrangles   '
 820       mess14(1,4,5)  = 'Pyramides     '
 821       mess14(1,4,6)  = 'Hexaedres     '
 822       mess14(1,4,7)  = 'Pentaedres    '
 823       mess14(1,4,8)  = 'Faces         '
 824       mess14(1,4,9)  = 'Volumes       '
 825       mess14(1,4,10) = '  Entites     '
 826       mess14(1,4,11) = 'Provisoires   '
 827       mess14(1,4,12) = 'Sans objet    '
 828       mess14(1,4,13) = 'Mailles       '
 829 c
 830       mess14(1,5,-1) = 'NOEUDS        '
 831       mess14(1,5,0)  = 'MAILLES-POINTS'
 832       mess14(1,5,1)  = 'SEGMENTS      '
 833       mess14(1,5,2)  = 'TRIANGLES     '
 834       mess14(1,5,3)  = 'TETRAEDRES    '
 835       mess14(1,5,4)  = 'QUADRANGLES   '
 836       mess14(1,5,5)  = 'PYRAMIDES     '
 837       mess14(1,5,6)  = 'HEXAEDRES     '
 838       mess14(1,5,7)  = 'PENTAEDRES    '
 839       mess14(1,5,8)  = 'FACES         '
 840       mess14(1,5,9)  = 'VOLUMES       '
 841       mess14(1,5,10) = '  ENTITES     '
 842       mess14(1,5,11) = 'PROVISOIRES   '
 843       mess14(1,5,12) = 'SANS OBJET    '
 844       mess14(1,5,13) = 'MAILLES       '
 845 c
 846       mess14(2,1,-1) = 'node          '
 847       mess14(2,1,0)  = 'point-mesh    '
 848       mess14(2,1,1)  = 'edge          '
 849       mess14(2,1,2)  = 'triangle      '
 850       mess14(2,1,3)  = 'tetrahedron   '
 851       mess14(2,1,4)  = 'quadrangle    '
 852       mess14(2,1,5)  = 'pyramid       '
 853       mess14(2,1,6)  = 'hexahedron    '
 854       mess14(2,1,7)  = 'prism         '
 855       mess14(2,1,8)  = 'face          '
 856       mess14(2,1,9)  = 'volume        '
 857       mess14(2,1,10) = '  entity      '
 858       mess14(2,1,11) = 'temporary     '
 859       mess14(2,1,12) = 'useless       '
 860       mess14(2,1,13) = 'mesh          '
 861 c
 862       mess14(2,2,-1) = 'Node          '
 863       mess14(2,2,0)  = 'Point-Mesh    '
 864       mess14(2,2,1)  = 'Edge          '
 865       mess14(2,2,2)  = 'Triangle      '
 866       mess14(2,2,3)  = 'Tetrahedron   '
 867       mess14(2,2,4)  = 'Quadrangle    '
 868       mess14(2,2,5)  = 'Pyramid       '
 869       mess14(2,2,6)  = 'Hexahedron    '
 870       mess14(2,2,7)  = 'Prism         '
 871       mess14(2,2,8)  = 'Face          '
 872       mess14(2,2,9)  = 'Volume        '
 873       mess14(2,2,10) = '  Entity      '
 874       mess14(2,2,11) = 'Temporary     '
 875       mess14(2,2,12) = 'Useless       '
 876       mess14(2,2,13) = 'Mesh          '
 877 c
 878       mess14(2,3,-1) = 'nodes         '
 879       mess14(2,3,0)  = 'point-meshes  '
 880       mess14(2,3,1)  = 'edges         '
 881       mess14(2,3,2)  = 'triangles     '
 882       mess14(2,3,3)  = 'tetraedra     '
 883       mess14(2,3,4)  = 'quadrangles   '
 884       mess14(2,3,5)  = 'pyramids      '
 885       mess14(2,3,6)  = 'hexahedrons   '
 886       mess14(2,3,7)  = 'prisms        '
 887       mess14(2,3,8)  = 'faces         '
 888       mess14(2,3,9)  = 'volumes       '
 889       mess14(2,3,10) = 'entities      '
 890       mess14(2,3,11) = 'Temporary     '
 891       mess14(2,3,12) = 'Useless       '
 892       mess14(2,3,13) = 'meshes        '
 893 c
 894       mess14(2,4,-1) = 'Nodes         '
 895       mess14(2,4,0)  = 'Point-Meshes  '
 896       mess14(2,4,1)  = 'Edges         '
 897       mess14(2,4,2)  = 'Triangles     '
 898       mess14(2,4,3)  = 'Tetraedra     '
 899       mess14(2,4,4)  = 'Quadrangles   '
 900       mess14(2,4,5)  = 'Pyramids      '
 901       mess14(2,4,6)  = 'Hexahedrons   '
 902       mess14(2,4,7)  = 'Prisms        '
 903       mess14(2,4,8)  = 'Faces         '
 904       mess14(2,4,9)  = 'Volumes       '
 905       mess14(2,4,10) = '  Entities    '
 906       mess14(2,4,11) = 'Temporary     '
 907       mess14(2,4,12) = 'Useless       '
 908       mess14(2,4,13) = 'Meshes        '
 909 c
 910       mess14(2,5,-1) = 'NODES         '
 911       mess14(2,5,0)  = 'POINT-MESHES  '
 912       mess14(2,5,1)  = 'EDGES         '
 913       mess14(2,5,2)  = 'TRIANGLES     '
 914       mess14(2,5,3)  = 'TETRAEDRA     '
 915       mess14(2,5,4)  = 'QUADRANGLES   '
 916       mess14(2,5,5)  = 'PYRAMIDS      '
 917       mess14(2,5,6)  = 'HEXAHEDRONS   '
 918       mess14(2,5,7)  = 'PRISMS        '
 919       mess14(2,5,8)  = 'FACES         '
 920       mess14(2,5,9)  = 'VOLUMES       '
 921       mess14(2,5,10) = '  ENTITIES    '
 922       mess14(2,5,11) = 'TEMPORARY     '
 923       mess14(2,5,12) = 'USELESS       '
 924       mess14(2,5,13) = 'MESHES        '
 925 c                       12345678901234
 926 c
 927 c====
 928 c 6. type gm
 929 c    remarque : le code doit etre le meme que pour mess14
 930 c====
 931 c
 932 c                     12345678
 933       suffix(1,-1) = 'Noeud   '
 934       suffix(1,0)  = 'Point   '
 935       suffix(1,1)  = 'Arete   '
 936       suffix(1,2)  = 'Trian   '
 937       suffix(1,3)  = 'Tetra   '
 938       suffix(1,4)  = 'Quadr   '
 939       suffix(1,5)  = 'Pyram   '
 940       suffix(1,6)  = 'Hexae   '
 941       suffix(1,7)  = 'Penta   '
 942       suffix(1,8)  = '        '
 943       suffix(1,9)  = '        '
 944       suffix(1,10) = '        '
 945 c
 946       suffix(2,-1) = 'noeu    '
 947       suffix(2,0)  = 'poin    '
 948       suffix(2,1)  = 'aret    '
 949       suffix(2,2)  = 'tria    '
 950       suffix(2,3)  = 'tetr    '
 951       suffix(2,4)  = 'quad    '
 952       suffix(2,5)  = 'pyra    '
 953       suffix(2,6)  = 'hexa    '
 954       suffix(2,7)  = 'pent    '
 955       suffix(2,8)  = '        '
 956       suffix(2,9)  = '        '
 957       suffix(2,10) = '        '
 958 c                     12345678
 959       suffix(3,-1) = 'No      '
 960       suffix(3,0)  = 'MP      '
 961       suffix(3,1)  = 'Ar      '
 962       suffix(3,2)  = 'Tr      '
 963       suffix(3,3)  = 'Te      '
 964       suffix(3,4)  = 'Qu      '
 965       suffix(3,5)  = 'Py      '
 966       suffix(3,6)  = 'He      '
 967       suffix(3,7)  = 'Pe      '
 968       suffix(3,8)  = '        '
 969       suffix(3,9)  = '        '
 970       suffix(3,10) = '        '
 971 c                     12345678
 972       suffix(4,-1) = 'no      '
 973       suffix(4,0)  = 'mp      '
 974       suffix(4,1)  = 'ar      '
 975       suffix(4,2)  = 'tr      '
 976       suffix(4,3)  = 'te      '
 977       suffix(4,4)  = 'qu      '
 978       suffix(4,5)  = 'py      '
 979       suffix(4,6)  = 'he      '
 980       suffix(4,7)  = 'pe      '
 981       suffix(4,8)  = '        '
 982       suffix(4,9)  = '        '
 983       suffix(4,10) = '        '
 984 c
 985 c====
 986 c 7. fonctions pour la conformite des hexaedres
 987 c====
 988 c
 989 #include "hexcf2.h"
 990 c
 991 c====
 992 c 8. Caracteristiques des familles :
 993 c====
 994 c 8.1. ==> initialisation des nombres maximaux de familles
 995 c
 996       nbfarm = 20000
 997       nbftrm = 20000
 998       nbfqum = 20000
 999 c
1000 #ifdef _DEBUG_HOMARD_
1001       write (*,90002) 'nbfarm', nbfarm
1002       write (*,90002) 'nbftrm', nbftrm
1003       write (*,90002) 'nbfqum', nbfqum
1004 #endif
1005 c
1006 c 8.2. ==> Caracteristiques par type de mailless
1007 c
1008 c  noeuds          1 : famille MED
1009 c                 Si extrusion :
1010 c                  2 : famille du noeud translate dans l'extrusion
1011 c                  3 : famille de l'arete creee dans l'extrusion
1012 c                  4 : position du noeud
1013 c                 Si equivalence :
1014 c                + l : appartenance a l'equivalence l
1015 c
1016 c  mailles-points  1 : famille MED
1017 c                  2 : type de maille-point
1018 c                  3 : famille du sommet support
1019 c                + l : appartenance a l'equivalence l
1020 c
1021 c  aretes          1 : famille MED
1022 c                  2 : type de segment
1023 c                  3 : orientation
1024 c                  4 : famille d'orientation inverse
1025 c                  5 : numero de ligne de frontiere
1026 c                       > 0 si arete concernee par le suivi de frontiere
1027 c                      <= 0 si non concernee
1028 c                  6 : famille de suivi de frontiere active/inactive
1029 c                  7 : numero de surface de frontiere
1030 c                 Si extrusion :
1031 c                  8 : famille de l'arete translatee dans l'extrusion
1032 c                  9 : famille du quadrangle cree dans l'extrusion
1033 c                 10 : position de l'arete
1034 c                 Si equivalence :
1035 c                + l : appartenance a l'equivalence l
1036 c
1037 c  triangles       1 : famille MED
1038 c                  2 : type de triangle
1039 c                  3 : numero de surface de frontiere
1040 c                  4 : famille des aretes internes apres raf
1041 c                 Si extrusion :
1042 c                  5 : famille du triangle translate dans l'extrusion
1043 c                  6 : famille du pentaedre cree dans l'extrusion
1044 c                  7 : orientation du triangle face du pentaedre
1045 c                  8 : position du triangle
1046 c                 Si equivalence :
1047 c                + l : appartenance a l'equivalence l
1048 c
1049 c  quadrangles     1 : famille MED
1050 c                  2 : type de quadrangle
1051 c                  3 : numero de surface de frontiere
1052 c                  4 : famille des aretes internes apres raf
1053 c                  5 : famille des triangles de conformite
1054 c                  6 : famille de suivi de frontiere active/inactive
1055 c                 Si extrusion :
1056 c                  7 : famille du quadrangle translate dans l'extrusion
1057 c                  8 : famille de l'hexaedre cree dans l'extrusion
1058 c                  9 : orientation du quadrangle face de l'hexaedre
1059 c                 10 : position du quadrangle
1060 c                 Si equivalence :
1061 c                + l : appartenance a l'equivalence l
1062 c
1063 c  tetraedres      1 : famille MED
1064 c                  2 : type de tetraedres
1065 c
1066 c  hexaedres       1 : famille MED
1067 c                  2 : type de hexaedres
1068 c                  3 : famille des tetraedres de conformite
1069 c                  4 : famille des pyramides de conformite
1070 c
1071 c  pyramides       1 : famille MED
1072 c                  2 : type de pyramides
1073 c
1074 c  pentaedres      1 : famille MED
1075 c                  2 : type de pentaedres
1076 c                  3 : famille des tetraedres de conformite
1077 c                  4 : famille des pyramides de conformite
1078 c====
1079 c
1080       ncffno = 1
1081       ncffmp = 3
1082       ncffar = 7
1083       ncfftr = 4
1084       ncffqu = 6
1085       ncffte = 2
1086       ncffhe = 4
1087       ncffpy = 2
1088       ncffpe = 4
1089 c
1090 #ifdef _DEBUG_HOMARD_
1091       write (*,90002) 'ncffno', ncffno
1092       write (*,90002) 'ncffmp', ncffmp
1093       write (*,90002) 'ncffar', ncffar
1094       write (*,90002) 'ncfftr', ncfftr
1095       write (*,90002) 'ncffqu', ncffqu
1096       write (*,90002) 'ncffte', ncffte
1097       write (*,90002) 'ncffhe', ncffhe
1098       write (*,90002) 'ncffpy', ncffpy
1099       write (*,90002) 'ncffpe', ncffpe
1100 #endif
1101 c
1102       ncxfno = 3
1103       ncxfar = 3
1104       ncxftr = 4
1105       ncxfqu = 4
1106 c
1107 #ifdef _DEBUG_HOMARD_
1108       write (*,90002) 'ncxfno', ncxfno
1109       write (*,90002) 'ncxfar', ncxfar
1110       write (*,90002) 'ncxftr', ncxftr
1111       write (*,90002) 'ncxfqu', ncxfqu
1112 #endif
1113 c
1114       nctfno = ncffno
1115       nctfmp = ncffmp
1116       nctfar = ncffar
1117       nctftr = ncfftr
1118       nctfqu = ncffqu
1119       nctfte = ncffte
1120       nctfhe = ncffhe
1121       nctfpy = ncffpy
1122       nctfpe = ncffpe
1123 c
1124       end