src/tool/Utilitaire/utinci.F

   1       subroutine utinci ( ulsort, langue, codret )
   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 Communs des Interfaces
  23 c    --           --                 -           -
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  29 c . langue . e   .    1   . langue des messages                        .
  30 c .        .     .        . 1 : francais, 2 : anglais                  .
  31 c . codret . es  .    1   . code de retour des modules                 .
  32 c .        .     .        . 0 : pas de probleme                        .
  33 c .        .     .        . 3 : probleme                               .
  34 c ______________________________________________________________________
  35 c
  36 c====
  37 c 0. declarations et dimensionnement
  38 c====
  39 c
  40 c 0.1. ==> generalites
  41 c
  42       implicit none
  43       save
  44 c
  45       character*6 nompro
  46       parameter ( nompro = 'UTINCI' )
  47 c
  48 #include "referx.h"
  49 c
  50 #include "nblang.h"
  51 #include "consts.h"
  52 c
  53 c 0.2. ==> communs
  54 c
  55 #include "envex1.h"
  56 c
  57 #include "refere.h"
  58 #include "refert.h"
  59 c
  60 #include "rfamed.h"
  61 c
  62 #include "rftmed.h"
  63 c
  64 c 0.3. ==> arguments
  65 c
  66       integer ulsort, langue, codret
  67 c
  68 c 0.4. ==> variables locales
  69 c
  70 #include "meddc0.h"
  71 c
  72       integer iaux, jaux
  73       character*6 saux06
  74 c
  75       integer iindef
  76       double precision rindef
  77       character*8 sindef
  78 c
  79       integer nbmess
  80       parameter ( nbmess = 10 )
  81       character*80 texte(nblang,nbmess)
  82 c
  83 c 0.5. ==> initialisations
  84 c ______________________________________________________________________
  85 c
  86 c====
  87 c 1. preliminaires
  88 c====
  89 c
  90 c 1.1. ==> messages
  91 c
  92 #include "impr01.h"
  93 c
  94 #ifdef _DEBUG_HOMARD_
  95       write (ulsort,texte(langue,1)) 'Entree', nompro
  96       call dmflsh (iaux)
  97 #endif
  98 c
  99       texte(1,4) = '(''Le type maximum pour HOMARD vaut :'',i6)'
 100       texte(1,5) = '(''mais la variable '',a6,'' vaut :'',i6)'
 101 c
 102       texte(2,4) = '(''Maximum type for HOMARD is :'',i6)'
 103       texte(2,5) = '(''but variable '',a6,'' is :'',i6)'
 104 c
 105       codret = 0
 106 c
 107 c====
 108 c 2. communs pour les interfaces
 109 c====
 110 c
 111 c 2.1. ==> prealable : les valeurs indefinies
 112 c
 113       call dmindf ( iindef, rindef, sindef )
 114 c
 115 c====
 116 c 3. generalites sur les elements de reference
 117 c====
 118 c
 119 c 3.1. ==> type HOMARD des differents elements
 120 c          on a interet a les prendre continus de 0 a themax, pour
 121 c          minimiser l'occupation en memoire.
 122 c          mais pour deboguer, il est interessant de varier ces chiffres
 123 c          il faut alors verifier qu'on ne depasse pas le maximum
 124 c          qui est defini par un parameter.
 125 c          attention, il faut utiliser en debug toutes les bibliotheques
 126 c          ou apparait tehmax
 127 c
 128       tyhnoe = -1
 129       tyhmpo = 0
 130       tyhse1 = 1
 131       tyhse2 = 2
 132       tyhtr1 = 3
 133       tyhtr2 = 4
 134       tyhte1 = 5
 135       tyhte2 = 6
 136       tyhqu1 = 7
 137       tyhqu2 = 8
 138       tyhpy1 = 9
 139       tyhpy2 = 10
 140       tyhhe1 = 11
 141       tyhhe2 = 12
 142       tyhpe1 = 13
 143       tyhpe2 = 14
 144       tyhtr3 = 15
 145       tyhqu3 = 16
 146       tyhhe3 = 17
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       tyhmpo = 7
 150       tyhse1 = 14
 151       tyhse2 = 17
 152       tyhtr1 = 28
 153       tyhtr2 = 21
 154       tyhte1 = 33
 155       tyhte2 = 30
 156 c
 157       tyhmpo = 6
 158       tyhse1 = 1
 159       tyhse2 = 4
 160       tyhtr1 = 2
 161       tyhtr2 = 5
 162       tyhte1 = 3
 163       tyhte2 = 0
 164       tyhqu1 = 7
 165       tyhqu2 = 8
 166 c
 167       tyhmpo = 0
 168       tyhse1 = 1
 169       tyhse2 = 2
 170       tyhtr1 = 3
 171       tyhtr2 = 4
 172       tyhte1 = 5
 173       tyhte2 = 6
 174       tyhqu1 = 7
 175       tyhqu2 = 8
 176 #endif
 177 c
 178       jaux = 0
 179       if ( tyhmpo.gt.tehmax ) then
 180         jaux = 2
 181         iaux = tyhmpo
 182         saux06 = 'tyhmpo'
 183       endif
 184       if ( tyhse1.gt.tehmax ) then
 185         jaux = 2
 186         iaux = tyhse1
 187         saux06 = 'tyhse1'
 188       endif
 189       if ( tyhse2.gt.tehmax ) then
 190         jaux = 2
 191         iaux = tyhse2
 192         saux06 = 'tyhse2'
 193       endif
 194       if ( tyhtr1.gt.tehmax ) then
 195         jaux = 2
 196         iaux = tyhtr1
 197         saux06 = 'tyhtr1'
 198       endif
 199       if ( tyhtr2.gt.tehmax ) then
 200         jaux = 2
 201         iaux = tyhtr2
 202         saux06 = 'tyhtr2'
 203       endif
 204       if ( tyhtr3.gt.tehmax ) then
 205         jaux = 2
 206         iaux = tyhtr3
 207         saux06 = 'tyhtr3'
 208       endif
 209       if ( tyhte1.gt.tehmax ) then
 210         jaux = 2
 211         iaux = tyhte1
 212         saux06 = 'tyhte1'
 213       endif
 214       if ( tyhte2.gt.tehmax ) then
 215         jaux = 2
 216         iaux = tyhte2
 217         saux06 = 'tyhte2'
 218       endif
 219       if ( tyhqu1.gt.tehmax ) then
 220         jaux = 2
 221         iaux = tyhqu1
 222         saux06 = 'tyhqu1'
 223       endif
 224       if ( tyhqu2.gt.tehmax ) then
 225         jaux = 2
 226         iaux = tyhqu2
 227         saux06 = 'tyhqu2'
 228       endif
 229       if ( tyhqu3.gt.tehmax ) then
 230         jaux = 2
 231         iaux = tyhqu3
 232         saux06 = 'tyhqu3'
 233       endif
 234       if ( tyhpy1.gt.tehmax ) then
 235         jaux = 2
 236         iaux = tyhpy1
 237         saux06 = 'tyhpy1'
 238       endif
 239       if ( tyhpy2.gt.tehmax ) then
 240         jaux = 2
 241         iaux = tyhpy2
 242         saux06 = 'tyhpy2'
 243       endif
 244       if ( tyhpe1.gt.tehmax ) then
 245         jaux = 2
 246         iaux = tyhpe1
 247         saux06 = 'tyhpe1'
 248       endif
 249       if ( tyhpe2.gt.tehmax ) then
 250         jaux = 2
 251         iaux = tyhpe2
 252         saux06 = 'tyhpe2'
 253       endif
 254       if ( tyhhe1.gt.tehmax ) then
 255         jaux = 2
 256         iaux = tyhhe1
 257         saux06 = 'tyhhe1'
 258       endif
 259       if ( tyhhe2.gt.tehmax ) then
 260         jaux = 2
 261         iaux = tyhhe2
 262         saux06 = 'tyhhe2'
 263       endif
 264       if ( tyhhe3.gt.tehmax ) then
 265         jaux = 2
 266         iaux = tyhhe3
 267         saux06 = 'tyhhe3'
 268       endif
 269       if ( jaux.ne.0 ) then
 270         write (ulsort,texte(langue,4)) tehmax
 271         write (ulsort,texte(langue,5)) saux06, iaux
 272         codret = 1
 273       endif
 274 c
 275 c 3.2. ==> prealable
 276 c tyeref : precise le type d'element en fonction du type de reference
 277 c          0 : standard HOMARD,
 278 c          1 : possible en fonction du type de travail
 279 c          2 : toujours interdit
 280 c nbnref : donne le nombre de noeuds en fonction du type de reference ;
 281 c          1er champ : type HOMARD de l'element de reference
 282 c          2eme champ : 1 : sommets
 283 c                       2 : sommets + milieux d'aretes
 284 c                       3 : total (sommets+milieux+internes)
 285 c nbaref : donne le nombre d'aretes en fonction du type de reference
 286 c nasref : donne le nombre d'aretes reliees a chaque sommet, sans
 287 c          se preoccuper d'orientation, en fonction du type
 288 c nfaref : donne le nombre de faces qui s'appuient sur chaque arete
 289 c          sans se preoccuper d'orientation
 290 c nafref : donne le nombre d'aretes de chaque face
 291 c          1er champ : type HOMARD de l'element de reference
 292 c          2eme champ : numero local de la face envisagee
 293 c defref : pour chaque arete de chaque face, donne le numero local
 294 c          de l'arete dans la description de l'element, sans se
 295 c          preoccuper d'orientation
 296 c          1er champ : type HOMARD de l'element de reference
 297 c          2eme champ : numero local de la face envisagee
 298 c          3eme champ : 1, 2, 3 et 4 pour chaque arete
 299 c faaref : donne le numero local de la face s'appuyant sur une arete
 300 c          1er champ : type HOMARD de l'element de reference
 301 c          2eme champ : numero local de l'arete concernee
 302 c          3eme champ : rang de la face envisagee
 303 c
 304       do 32 , iaux = 0 , tehmax
 305         tyeref(iaux) = iindef
 306         nbnref(iaux,1) = iindef
 307         nbnref(iaux,2) = iindef
 308         nbnref(iaux,3) = iindef
 309         nbaref(iaux) = iindef
 310         nasref(iaux) = iindef
 311         nfaref(iaux) = iindef
 312         do 321 , jaux = 1 , 6
 313           nafref(iaux,jaux) = iindef
 314           defref(iaux,jaux,1) = iindef
 315           defref(iaux,jaux,2) = iindef
 316           defref(iaux,jaux,3) = iindef
 317           defref(iaux,jaux,4) = iindef
 318   321   continue
 319         do 322 , jaux = 1, 12
 320           faaref(iaux,jaux,1) = iindef
 321           faaref(iaux,jaux,2) = iindef
 322   322   continue
 323    32 continue
 324 c
 325 c 3.3. ==> description d'une maille-point
 326 c
 327       tyeref(tyhmpo) = 0
 328       nbnref(tyhmpo,1) = 1
 329       nbnref(tyhmpo,2) = nbnref(tyhmpo,1)
 330       nbnref(tyhmpo,3) = nbnref(tyhmpo,2)
 331       nbaref(tyhmpo) = 0
 332       nasref(tyhmpo) = 0
 333       nfaref(tyhmpo) = 0
 334 c
 335 c 3.4. ==> description d'un segment
 336 c
 337 c 3.4.1. ==> lineaire
 338 c
 339       tyeref(tyhse1) = 0
 340       nbnref(tyhse1,1) = 2
 341       nbnref(tyhse1,2) = nbnref(tyhse1,1)
 342       nbnref(tyhse1,3) = nbnref(tyhse1,2)
 343       nbaref(tyhse1) = 1
 344       nasref(tyhse1) = 1
 345       nfaref(tyhse1) = 0
 346 c
 347 c 3.4.2. ==> quadratique
 348 c
 349       tyeref(tyhse2) = tyeref(tyhse1)
 350       nbnref(tyhse2,1) = nbnref(tyhse1,1)
 351       nbnref(tyhse2,2) = 3
 352       nbnref(tyhse2,3) = nbnref(tyhse2,2)
 353       nbaref(tyhse2) = nbaref(tyhse1)
 354       nasref(tyhse2) = nasref(tyhse1)
 355       nfaref(tyhse2) = nfaref(tyhse1)
 356 c
 357 c 3.5. ==> description d'un triangle
 358 c
 359 c 3.5.1. ==> lineaire
 360 c
 361       tyeref(tyhtr1) = 0
 362       nbnref(tyhtr1,1) = 3
 363       nbnref(tyhtr1,2) = nbnref(tyhtr1,1)
 364       nbnref(tyhtr1,3) = nbnref(tyhtr1,2)
 365       nbaref(tyhtr1) = 3
 366       nasref(tyhtr1) = 2
 367       nfaref(tyhtr1) = 1
 368 c
 369       nafref(tyhtr1,1) = 3
 370       defref(tyhtr1,1,1) = 1
 371       defref(tyhtr1,1,2) = 2
 372       defref(tyhtr1,1,3) = 3
 373 c
 374       faaref(tyhtr1,1,1) = 1
 375       faaref(tyhtr1,2,1) = 1
 376       faaref(tyhtr1,3,1) = 1
 377 c
 378 c 3.5.2. ==> complements pour le quadratique
 379 c
 380       tyeref(tyhtr2) = tyeref(tyhtr1)
 381       nbnref(tyhtr2,1) = nbnref(tyhtr1,1)
 382       nbnref(tyhtr2,2) = 6
 383       nbnref(tyhtr2,3) = nbnref(tyhtr2,2)
 384       nbaref(tyhtr2) = nbaref(tyhtr1)
 385       nasref(tyhtr2) = nasref(tyhtr1)
 386       nfaref(tyhtr2) = nfaref(tyhtr1)
 387 c
 388 c 3.5.3. ==> complements pour le quadratique etendu
 389 c
 390       tyeref(tyhtr3) = tyeref(tyhtr1)
 391       nbnref(tyhtr3,1) = nbnref(tyhtr2,1)
 392       nbnref(tyhtr3,2) = nbnref(tyhtr2,2)
 393       nbnref(tyhtr3,3) = 7
 394       nbaref(tyhtr3) = nbaref(tyhtr1)
 395       nasref(tyhtr3) = nasref(tyhtr1)
 396       nfaref(tyhtr3) = nfaref(tyhtr1)
 397 c
 398 c 3.6. ==> description d'un quadrangle
 399 c
 400 c 3.6.1. ==> lineaire
 401 c
 402       tyeref(tyhqu1) = 0
 403       nbnref(tyhqu1,1) = 4
 404       nbnref(tyhqu1,2) = nbnref(tyhqu1,1)
 405       nbnref(tyhqu1,3) = nbnref(tyhqu1,2)
 406       nbaref(tyhqu1) = 4
 407       nasref(tyhqu1) = 2
 408       nfaref(tyhqu1) = 1
 409 c
 410       nafref(tyhqu1,1) = 4
 411       defref(tyhqu1,1,1) = 1
 412       defref(tyhqu1,1,2) = 2
 413       defref(tyhqu1,1,3) = 3
 414       defref(tyhqu1,1,4) = 4
 415 c
 416       faaref(tyhqu1,1,1) = 1
 417       faaref(tyhqu1,2,1) = 1
 418       faaref(tyhqu1,3,1) = 1
 419       faaref(tyhqu1,4,1) = 1
 420 c
 421 c 3.6.2. ==> complements pour le quadratique
 422 c
 423       tyeref(tyhqu2) = tyeref(tyhqu1)
 424       nbnref(tyhqu2,1) = nbnref(tyhqu1,1)
 425       nbnref(tyhqu2,2) = 8
 426       nbnref(tyhqu2,3) = nbnref(tyhqu2,2)
 427       nbaref(tyhqu2) = nbaref(tyhqu1)
 428       nasref(tyhqu2) = nasref(tyhqu1)
 429       nfaref(tyhqu2) = nfaref(tyhqu1)
 430 c
 431 c 3.6.3. ==> complements pour le quadratique etendu
 432 c
 433       tyeref(tyhqu3) = tyeref(tyhqu1)
 434       nbnref(tyhqu3,1) = nbnref(tyhqu2,1)
 435       nbnref(tyhqu3,2) = nbnref(tyhqu2,2)
 436       nbnref(tyhqu3,3) = 9
 437       nbaref(tyhqu3) = nbaref(tyhqu1)
 438       nasref(tyhqu3) = nasref(tyhqu1)
 439       nfaref(tyhqu3) = nfaref(tyhqu1)
 440 c
 441 c 3.7. ==> description d'un tetraedre
 442 c
 443 c 3.7.1. ==> lineaire
 444 c
 445       tyeref(tyhte1) = 0
 446       nbnref(tyhte1,1) = 4
 447       nbnref(tyhte1,2) = nbnref(tyhte1,1)
 448       nbnref(tyhte1,2) = nbnref(tyhte1,1)
 449       nbnref(tyhte1,3) = nbnref(tyhte1,2)
 450       nbaref(tyhte1) = 6
 451       nasref(tyhte1) = 3
 452       nfaref(tyhte1) = 2
 453 c
 454       nafref(tyhte1,1) = 3
 455       defref(tyhte1,1,1) = 4
 456       defref(tyhte1,1,2) = 5
 457       defref(tyhte1,1,3) = 6
 458       nafref(tyhte1,2) = 3
 459       defref(tyhte1,2,1) = 2
 460       defref(tyhte1,2,2) = 3
 461       defref(tyhte1,2,3) = 6
 462       nafref(tyhte1,3) = 3
 463       defref(tyhte1,3,1) = 1
 464       defref(tyhte1,3,2) = 3
 465       defref(tyhte1,3,3) = 5
 466       nafref(tyhte1,4) = 3
 467       defref(tyhte1,4,1) = 1
 468       defref(tyhte1,4,2) = 2
 469       defref(tyhte1,4,3) = 4
 470 c
 471       faaref(tyhte1,1,1) = 3
 472       faaref(tyhte1,1,2) = 4
 473       faaref(tyhte1,2,1) = 2
 474       faaref(tyhte1,2,2) = 4
 475       faaref(tyhte1,3,1) = 2
 476       faaref(tyhte1,3,2) = 3
 477       faaref(tyhte1,4,1) = 1
 478       faaref(tyhte1,4,2) = 4
 479       faaref(tyhte1,5,1) = 1
 480       faaref(tyhte1,5,2) = 3
 481       faaref(tyhte1,6,1) = 1
 482       faaref(tyhte1,6,2) = 2
 483 c
 484 c 3.7.2. ==> complements pour le quadratique
 485 c
 486       tyeref(tyhte2) = tyeref(tyhte1)
 487       nbnref(tyhte2,1) = nbnref(tyhte1,1)
 488       nbnref(tyhte2,2) = 10
 489       nbnref(tyhte2,3) = nbnref(tyhte2,2)
 490       nbaref(tyhte2) = nbaref(tyhte1)
 491       nasref(tyhte2) = nasref(tyhte1)
 492       nfaref(tyhte2) = nfaref(tyhte1)
 493 c
 494 c 3.8. ==> description d'une pyramide
 495 c
 496 c 3.8.1. ==> lineaire
 497 c
 498       tyeref(tyhpy1) = 1
 499       nbnref(tyhpy1,1) = 5
 500       nbnref(tyhpy1,2) = nbnref(tyhpy1,1)
 501       nbnref(tyhpy1,3) = nbnref(tyhpy1,2)
 502       nbaref(tyhpy1) = 8
 503       nasref(tyhpy1) = 3
 504       nfaref(tyhpy1) = 2
 505 c
 506       nafref(tyhpy1,1) = 3
 507       defref(tyhpy1,1,1) = 1
 508       defref(tyhpy1,1,2) = 2
 509       defref(tyhpy1,1,3) = 5
 510       nafref(tyhpy1,2) = 3
 511       defref(tyhpy1,2,1) = 2
 512       defref(tyhpy1,2,2) = 3
 513       defref(tyhpy1,2,3) = 6
 514       nafref(tyhpy1,3) = 3
 515       defref(tyhpy1,3,1) = 3
 516       defref(tyhpy1,3,2) = 4
 517       defref(tyhpy1,3,3) = 7
 518       nafref(tyhpy1,4) = 3
 519       defref(tyhpy1,4,1) = 1
 520       defref(tyhpy1,4,2) = 8
 521       defref(tyhpy1,4,3) = 4
 522       nafref(tyhpy1,5) = 4
 523       defref(tyhpy1,5,1) = 5
 524       defref(tyhpy1,5,2) = 6
 525       defref(tyhpy1,5,3) = 7
 526       defref(tyhpy1,5,4) = 8
 527 c
 528       faaref(tyhpy1,1,1) = 4
 529       faaref(tyhpy1,1,2) = 1
 530       faaref(tyhpy1,2,1) = 1
 531       faaref(tyhpy1,2,2) = 2
 532       faaref(tyhpy1,3,1) = 2
 533       faaref(tyhpy1,3,2) = 3
 534       faaref(tyhpy1,4,1) = 3
 535       faaref(tyhpy1,4,2) = 4
 536       faaref(tyhpy1,5,1) = 1
 537       faaref(tyhpy1,5,2) = 5
 538       faaref(tyhpy1,6,1) = 2
 539       faaref(tyhpy1,6,2) = 5
 540       faaref(tyhpy1,7,1) = 3
 541       faaref(tyhpy1,7,2) = 5
 542       faaref(tyhpy1,8,1) = 4
 543       faaref(tyhpy1,8,2) = 5
 544 c
 545 c 3.8.2. ==> complements pour le quadratique
 546 c
 547       tyeref(tyhpy2) = tyeref(tyhpy1)
 548       nbnref(tyhpy2,1) = nbnref(tyhpy1,1)
 549       nbnref(tyhpy2,2) = 13
 550       nbnref(tyhpy2,3) = nbnref(tyhpy2,2)
 551       nbaref(tyhpy2) = nbaref(tyhpy1)
 552       nasref(tyhpy2) = nasref(tyhpy1)
 553       nfaref(tyhpy2) = nfaref(tyhpy1)
 554 c
 555 c 3.9. ==> description d'un hexaedre
 556 c
 557 c 3.9.1. ==> lineaire
 558 c
 559       tyeref(tyhhe1) = 0
 560       nbnref(tyhhe1,1) = 8
 561       nbnref(tyhhe1,2) = nbnref(tyhhe1,1)
 562       nbnref(tyhhe1,3) = nbnref(tyhhe1,2)
 563       nbaref(tyhhe1) = 12
 564       nasref(tyhhe1) = 3
 565       nfaref(tyhhe1) = 2
 566 c
 567       nafref(tyhhe1,1) = 4
 568       defref(tyhhe1,1,1) = 1
 569       defref(tyhhe1,1,2) = 2
 570       defref(tyhhe1,1,3) = 4
 571       defref(tyhhe1,1,4) = 3
 572       nafref(tyhhe1,2) = 4
 573       defref(tyhhe1,2,1) = 1
 574       defref(tyhhe1,2,2) = 6
 575       defref(tyhhe1,2,3) = 9
 576       defref(tyhhe1,2,4) = 5
 577       nafref(tyhhe1,3) = 4
 578       defref(tyhhe1,3,1) = 2
 579       defref(tyhhe1,3,2) = 5
 580       defref(tyhhe1,3,3) = 10
 581       defref(tyhhe1,3,4) = 7
 582       nafref(tyhhe1,4) = 4
 583       defref(tyhhe1,4,1) = 3
 584       defref(tyhhe1,4,2) = 8
 585       defref(tyhhe1,4,3) = 11
 586       defref(tyhhe1,4,4) = 6
 587       nafref(tyhhe1,5) = 4
 588       defref(tyhhe1,5,1) = 4
 589       defref(tyhhe1,5,2) = 7
 590       defref(tyhhe1,5,3) = 12
 591       defref(tyhhe1,5,4) = 8
 592       nafref(tyhhe1,6) = 4
 593       defref(tyhhe1,6,1) = 9
 594       defref(tyhhe1,6,2) = 11
 595       defref(tyhhe1,6,3) = 12
 596       defref(tyhhe1,6,4) = 10
 597 c
 598       faaref(tyhhe1,1,1) = 1
 599       faaref(tyhhe1,1,2) = 2
 600       faaref(tyhhe1,2,1) = 1
 601       faaref(tyhhe1,2,2) = 3
 602       faaref(tyhhe1,3,1) = 1
 603       faaref(tyhhe1,3,2) = 4
 604       faaref(tyhhe1,4,1) = 1
 605       faaref(tyhhe1,4,2) = 5
 606       faaref(tyhhe1,5,1) = 2
 607       faaref(tyhhe1,5,2) = 3
 608       faaref(tyhhe1,6,1) = 2
 609       faaref(tyhhe1,6,2) = 4
 610       faaref(tyhhe1,7,1) = 3
 611       faaref(tyhhe1,7,2) = 5
 612       faaref(tyhhe1,8,1) = 4
 613       faaref(tyhhe1,8,2) = 5
 614       faaref(tyhhe1,9,1) = 2
 615       faaref(tyhhe1,9,2) = 6
 616       faaref(tyhhe1,10,1) = 3
 617       faaref(tyhhe1,10,2) = 6
 618       faaref(tyhhe1,11,1) = 4
 619       faaref(tyhhe1,11,2) = 6
 620       faaref(tyhhe1,12,1) = 5
 621       faaref(tyhhe1,12,2) = 6
 622 c
 623 c 3.9.2. ==> complements pour le quadratique
 624 c
 625       tyeref(tyhhe2) = tyeref(tyhhe1)
 626       nbnref(tyhhe2,1) = nbnref(tyhhe1,1)
 627       nbnref(tyhhe2,2) = 20
 628       nbnref(tyhhe2,3) = nbnref(tyhhe2,2)
 629       nbaref(tyhhe2) = nbaref(tyhhe1)
 630       nasref(tyhhe2) = nasref(tyhhe1)
 631       nfaref(tyhhe2) = nfaref(tyhhe1)
 632 c
 633 c 3.9.3. ==> complements pour le quadratique etendu
 634 c
 635       tyeref(tyhhe3) = tyeref(tyhhe1)
 636       nbnref(tyhhe3,1) = nbnref(tyhhe2,1)
 637       nbnref(tyhhe3,2) = nbnref(tyhhe2,2)
 638       nbnref(tyhhe3,3) = 27
 639       nbaref(tyhhe3) = nbaref(tyhhe1)
 640       nasref(tyhhe3) = nasref(tyhhe1)
 641       nfaref(tyhhe3) = nfaref(tyhhe1)
 642 c
 643 c 3.10. ==> description d'un pentaedre
 644 c 3.10.1. ==> lineaire
 645 c
 646       tyeref(tyhpe1) = 0
 647       nbnref(tyhpe1,1) = 6
 648       nbnref(tyhpe1,2) = nbnref(tyhpe1,1)
 649       nbnref(tyhpe1,3) = nbnref(tyhpe1,2)
 650       nbaref(tyhpe1) = 9
 651       nasref(tyhpe1) = 3
 652       nfaref(tyhpe1) = 2
 653 c
 654       nafref(tyhpe1,1) = 3
 655       defref(tyhpe1,1,1) = 1
 656       defref(tyhpe1,1,2) = 2
 657       defref(tyhpe1,1,3) = 3
 658       nafref(tyhpe1,2) = 3
 659       defref(tyhpe1,2,1) = 4
 660       defref(tyhpe1,2,2) = 6
 661       defref(tyhpe1,2,3) = 5
 662       nafref(tyhpe1,3) = 4
 663       defref(tyhpe1,3,1) = 1
 664       defref(tyhpe1,3,2) = 9
 665       defref(tyhpe1,3,3) = 4
 666       defref(tyhpe1,3,4) = 7
 667       nafref(tyhpe1,4) = 4
 668       defref(tyhpe1,4,1) = 2
 669       defref(tyhpe1,4,2) = 7
 670       defref(tyhpe1,4,3) = 5
 671       defref(tyhpe1,4,4) = 8
 672       nafref(tyhpe1,5) = 4
 673       defref(tyhpe1,5,1) = 3
 674       defref(tyhpe1,5,2) = 8
 675       defref(tyhpe1,5,3) = 6
 676       defref(tyhpe1,5,4) = 9
 677 c
 678       faaref(tyhpe1,1,1) = 1
 679       faaref(tyhpe1,1,2) = 3
 680       faaref(tyhpe1,2,1) = 1
 681       faaref(tyhpe1,2,2) = 4
 682       faaref(tyhpe1,3,1) = 1
 683       faaref(tyhpe1,3,2) = 5
 684       faaref(tyhpe1,4,1) = 2
 685       faaref(tyhpe1,4,2) = 3
 686       faaref(tyhpe1,5,1) = 2
 687       faaref(tyhpe1,5,2) = 4
 688       faaref(tyhpe1,6,1) = 2
 689       faaref(tyhpe1,6,2) = 5
 690       faaref(tyhpe1,7,1) = 3
 691       faaref(tyhpe1,7,2) = 4
 692       faaref(tyhpe1,8,1) = 4
 693       faaref(tyhpe1,8,2) = 5
 694       faaref(tyhpe1,9,1) = 5
 695       faaref(tyhpe1,9,2) = 3
 696 c
 697 c 3.10.2. ==> complements pour le quadratique
 698 c
 699       tyeref(tyhpe2) = tyeref(tyhpe1)
 700       nbnref(tyhpe2,1) = nbnref(tyhpe1,1)
 701       nbnref(tyhpe2,2) = 15
 702       nbnref(tyhpe2,3) = nbnref(tyhpe2,2)
 703       nbaref(tyhpe2) = nbaref(tyhpe1)
 704       nasref(tyhpe2) = nasref(tyhpe1)
 705       nfaref(tyhpe2) = nfaref(tyhpe1)
 706 c
 707 c 3.11. ==> En quadratique
 708 c           On en fait trop mais cela simpilife l'ecriture
 709 c
 710       do 3111 , iaux = 1, 6
 711 c
 712         nafref(tyhtr2,iaux) = nafref(tyhtr1,iaux)
 713         defref(tyhtr2,iaux,1) = defref(tyhtr1,iaux,1)
 714         defref(tyhtr2,iaux,2) = defref(tyhtr1,iaux,2)
 715         defref(tyhtr2,iaux,3) = defref(tyhtr1,iaux,3)
 716 c
 717         nafref(tyhtr3,iaux) = nafref(tyhtr1,iaux)
 718         defref(tyhtr3,iaux,1) = defref(tyhtr1,iaux,1)
 719         defref(tyhtr3,iaux,2) = defref(tyhtr1,iaux,2)
 720         defref(tyhtr3,iaux,3) = defref(tyhtr1,iaux,3)
 721 c
 722         nafref(tyhqu2,iaux) = nafref(tyhqu1,iaux)
 723         defref(tyhqu2,iaux,1) = defref(tyhqu1,iaux,1)
 724         defref(tyhqu2,iaux,2) = defref(tyhqu1,iaux,2)
 725         defref(tyhqu2,iaux,3) = defref(tyhqu1,iaux,3)
 726         defref(tyhqu2,iaux,4) = defref(tyhqu1,iaux,4)
 727 c
 728         nafref(tyhqu3,iaux) = nafref(tyhqu1,iaux)
 729         defref(tyhqu3,iaux,1) = defref(tyhqu1,iaux,1)
 730         defref(tyhqu3,iaux,2) = defref(tyhqu1,iaux,2)
 731         defref(tyhqu3,iaux,3) = defref(tyhqu1,iaux,3)
 732         defref(tyhqu3,iaux,4) = defref(tyhqu1,iaux,4)
 733 c
 734         nafref(tyhte2,iaux) = nafref(tyhte1,iaux)
 735         defref(tyhte2,iaux,1) = defref(tyhte1,iaux,1)
 736         defref(tyhte2,iaux,2) = defref(tyhte1,iaux,2)
 737         defref(tyhte2,iaux,3) = defref(tyhte1,iaux,3)
 738 c
 739         nafref(tyhpy2,iaux) = nafref(tyhpy1,iaux)
 740         defref(tyhpy2,iaux,1) = defref(tyhpy1,iaux,1)
 741         defref(tyhpy2,iaux,2) = defref(tyhpy1,iaux,2)
 742         defref(tyhpy2,iaux,3) = defref(tyhpy1,iaux,3)
 743         defref(tyhpy2,iaux,4) = defref(tyhpy1,iaux,4)
 744 c
 745         nafref(tyhhe2,iaux) = nafref(tyhhe1,iaux)
 746         defref(tyhhe2,iaux,1) = defref(tyhhe1,iaux,1)
 747         defref(tyhhe2,iaux,2) = defref(tyhhe1,iaux,2)
 748         defref(tyhhe2,iaux,3) = defref(tyhhe1,iaux,3)
 749         defref(tyhhe2,iaux,4) = defref(tyhhe1,iaux,4)
 750 c
 751         nafref(tyhhe3,iaux) = nafref(tyhhe1,iaux)
 752         defref(tyhhe3,iaux,1) = defref(tyhhe1,iaux,1)
 753         defref(tyhhe3,iaux,2) = defref(tyhhe1,iaux,2)
 754         defref(tyhhe3,iaux,3) = defref(tyhhe1,iaux,3)
 755         defref(tyhhe3,iaux,4) = defref(tyhhe1,iaux,4)
 756 c
 757         nafref(tyhpe2,iaux) = nafref(tyhpe1,iaux)
 758         defref(tyhpe2,iaux,1) = defref(tyhpe1,iaux,1)
 759         defref(tyhpe2,iaux,2) = defref(tyhpe1,iaux,2)
 760         defref(tyhpe2,iaux,3) = defref(tyhpe1,iaux,3)
 761         defref(tyhpe2,iaux,4) = defref(tyhpe1,iaux,4)
 762 c
 763  3111 continue
 764 c
 765       do 3112 , iaux = 1, 12
 766 c
 767         faaref(tyhtr2,iaux,1) = faaref(tyhtr1,iaux,1)
 768         faaref(tyhtr2,iaux,2) = faaref(tyhtr1,iaux,2)
 769 c
 770         faaref(tyhtr3,iaux,1) = faaref(tyhtr1,iaux,1)
 771         faaref(tyhtr3,iaux,2) = faaref(tyhtr1,iaux,2)
 772 c
 773         faaref(tyhqu2,iaux,1) = faaref(tyhqu1,iaux,1)
 774         faaref(tyhqu2,iaux,2) = faaref(tyhqu1,iaux,2)
 775 c
 776         faaref(tyhqu3,iaux,1) = faaref(tyhqu1,iaux,1)
 777         faaref(tyhqu3,iaux,2) = faaref(tyhqu1,iaux,2)
 778 c
 779         faaref(tyhte2,iaux,1) = faaref(tyhte1,iaux,1)
 780         faaref(tyhte2,iaux,2) = faaref(tyhte1,iaux,2)
 781 c
 782         faaref(tyhpy2,iaux,1) = faaref(tyhpy1,iaux,1)
 783         faaref(tyhpy2,iaux,2) = faaref(tyhpy1,iaux,2)
 784 c
 785         faaref(tyhhe2,iaux,1) = faaref(tyhhe1,iaux,1)
 786         faaref(tyhhe2,iaux,2) = faaref(tyhhe1,iaux,2)
 787 c
 788         faaref(tyhhe3,iaux,1) = faaref(tyhhe1,iaux,1)
 789         faaref(tyhhe3,iaux,2) = faaref(tyhhe1,iaux,2)
 790 c
 791         faaref(tyhpe2,iaux,1) = faaref(tyhpe1,iaux,1)
 792         faaref(tyhpe2,iaux,2) = faaref(tyhpe1,iaux,2)
 793 c
 794  3112 continue
 795 c
 796 c====
 797 c 4. types HOMARD associe au format commun MED
 798 c====
 799 c
 800 c 4.0. ==> initialisation des types generaux
 801 c
 802       do 40 , iaux = 0 , nbtmed
 803         mednnm(iaux) = iindef
 804         medtrf(iaux) = iindef
 805         medt12(iaux) = iindef
 806    40 continue
 807 c
 808 c 4.1. ==> description du sommet
 809 c
 810       medtrf(0) = tyhnoe
 811       medt12(0) = 0
 812 c
 813 c 4.2. ==> description de la maille-point
 814 c
 815       mednnm(edpoi1) = 1
 816       medtrf(edpoi1) = tyhmpo
 817       medt12(edpoi1) = edpoi1
 818 c
 819 c 4.3. ==> description du segment
 820 c
 821 c 4.3.1. ==> lineaire
 822 c
 823       mednnm(edseg2) = 2
 824       medtrf(edseg2) = tyhse1
 825       medt12(edseg2) = edseg3
 826 c
 827 c 4.3.2. ==> quadratique
 828 c
 829       mednnm(edseg3) = 3
 830       medtrf(edseg3) = tyhse2
 831       medt12(edseg3) = edseg2
 832 c
 833 c 4.4. ==> description du triangle
 834 c
 835 c 4.4.1. ==> lineaire
 836 c
 837       mednnm(edtri3) = 3
 838       medtrf(edtri3) = tyhtr1
 839       medt12(edtri3) = edtri6
 840 c
 841 c 4.4.2. ==> quadratique
 842 c
 843       mednnm(edtri6) = 6
 844       medtrf(edtri6) = tyhtr2
 845       medt12(edtri6) = edtri3
 846 c
 847 c 4.4.3. ==> quadratique etendu
 848 c
 849       mednnm(edtri7) = 7
 850       medtrf(edtri7) = tyhtr3
 851       medt12(edtri7) = edtri3
 852 c
 853 c 4.5. ==> description du quadrangle
 854 c
 855 c 4.5.1. ==> lineaire
 856 c
 857       mednnm(edqua4) = 4
 858       medtrf(edqua4) = tyhqu1
 859       medt12(edqua4) = edqua8
 860 c
 861 c 4.5.2. ==> quadratique
 862 c
 863       mednnm(edqua8) = 8
 864       medtrf(edqua8) = tyhqu2
 865       medt12(edqua8) = edqua4
 866 c
 867 c 4.5.3. ==> quadratique etendu
 868 c
 869       mednnm(edqua9) = 9
 870       medtrf(edqua9) = tyhqu3
 871       medt12(edqua9) = edqua4
 872 c
 873 c 4.6. ==> description du tetraedre
 874 c
 875 c 4.6.1. ==> lineaire
 876 c
 877       mednnm(edtet4) = 4
 878       medtrf(edtet4) = tyhte1
 879       medt12(edtet4) = edte10
 880 c
 881 c 4.6.2. ==> quadratique
 882 c
 883       mednnm(edte10) = 10
 884       medtrf(edte10) = tyhte2
 885       medt12(edte10) = edtet4
 886 c
 887 c 4.7. ==> description de la pyramide
 888 c
 889 c 4.7.1. ==> lineaire
 890 c
 891       mednnm(edpyr5) = 5
 892       medtrf(edpyr5) = tyhpy1
 893       medt12(edpyr5) = edpy13
 894 c
 895 c 4.7.2. ==> quadratique
 896 c
 897       mednnm(edpy13) = 13
 898       medtrf(edpy13) = tyhpy2
 899       medt12(edpy13) = edpyr5
 900 c
 901 c 4.8. ==> description de l'hexaedre
 902 c
 903 c 4.8.1. ==> lineaire
 904 c
 905       mednnm(edhex8) = 8
 906       medtrf(edhex8) = tyhhe1
 907       medt12(edhex8) = edhe20
 908 c
 909 c 4.8.2. ==> quadratique
 910 c
 911       mednnm(edhe20) = 20
 912       medtrf(edhe20) = tyhhe2
 913       medt12(edhe20) = edhex8
 914 c
 915 c 4.8.2. ==> quadratique etendu
 916 c
 917       mednnm(edhe27) = 27
 918       medtrf(edhe27) = tyhhe3
 919       medt12(edhe27) = edhex8
 920 c
 921 c 4.9. ==> description du pentaedre
 922 c
 923 c 4.9.1. ==> lineaire
 924 c
 925       mednnm(edpen6) = 6
 926       medtrf(edpen6) = tyhpe1
 927       medt12(edpen6) = edpe15
 928 c
 929 c 4.9.2. ==> quadratique
 930 c
 931       mednnm(edpe15) = 15
 932       medtrf(edpe15) = tyhpe2
 933       medt12(edpe15) = edpen6
 934 c
 935 c====
 936 c 5. description pour une connectivite a la med
 937 c====
 938 c
 939 c 5.1. ==> prealable
 940 c
 941       do 51 , iaux = 0 , tehmax
 942         do 511 , jaux = 1 , 10
 943           arsmed(iaux,jaux,1) = iindef
 944           arsmed(iaux,jaux,2) = iindef
 945           arsmed(iaux,jaux,3) = iindef
 946           arsmed(iaux,jaux,4) = iindef
 947   511   continue
 948         do 512 , jaux = 1 , 12
 949           deamed(iaux,jaux,1) = iindef
 950           deamed(iaux,jaux,2) = iindef
 951           deamed(iaux,jaux,3) = iindef
 952   512   continue
 953    51 continue
 954 c
 955 c 5.2. ==> description de la poutre
 956 c
 957 c 5.2.1. ==> lineaire
 958 c                           a1
 959 c                  n1*-------------*n2
 960 c
 961       arsmed(tyhse1,1,1) = 1
 962       arsmed(tyhse1,2,1) = 1
 963 c
 964       deamed(tyhse1,1,1) = 1
 965       deamed(tyhse1,1,2) = 2
 966 c
 967 c 5.2.2. ==> complements pour le quadratique
 968 c                           a1
 969 c                  n1*------*------*n2
 970 c                          n3
 971       deamed(tyhse2,1,3) = 3
 972 c
 973 c 5.3. ==> description du triangle
 974 c
 975 c 5.3.1. ==> lineaire
 976 c                           a1
 977 c                  n1*---------------*n2
 978 c                     .             .
 979 c                      .           .
 980 c                       .         .
 981 c                     a2 .       .  a3
 982 c                         .     .
 983 c                          .   .
 984 c                           . .
 985 c                            *
 986 c                           n3
 987 c
 988       arsmed(tyhtr1,1,1) = 1
 989       arsmed(tyhtr1,1,2) = 2
 990       arsmed(tyhtr1,2,1) = 1
 991       arsmed(tyhtr1,2,2) = 3
 992       arsmed(tyhtr1,3,1) = 2
 993       arsmed(tyhtr1,3,2) = 3
 994 c
 995       deamed(tyhtr1,1,1) = 1
 996       deamed(tyhtr1,1,2) = 2
 997       deamed(tyhtr1,2,1) = 1
 998       deamed(tyhtr1,2,2) = 3
 999       deamed(tyhtr1,3,1) = 2
1000       deamed(tyhtr1,3,2) = 3
1001 c
1002 c 5.3.2. ==> complements pour le quadratique
1003 c                           a1
1004 c                  n1*-------*-------*n2
1005 c                     .    n4       .
1006 c                      .           .
1007 c                       .         .
1008 c                     a2 *n6     *n5 a3
1009 c                         .     .
1010 c                          .   .
1011 c                           . .
1012 c                            *
1013 c                           n3
1014 c
1015       deamed(tyhtr2,1,3) = 4
1016       deamed(tyhtr2,2,3) = 6
1017       deamed(tyhtr2,3,3) = 5
1018 c
1019       do 532 , iaux = 1, 3
1020         deamed(tyhtr3,iaux,3) = deamed(tyhtr2,iaux,3)
1021   532 continue
1022 c
1023 c 5.4. ==> description du quadrangle
1024 c
1025 c 5.4.1. ==> lineaire
1026 c                           a1
1027 c                  n1*---------------*n2
1028 c                    .               .
1029 c                    .               .
1030 c                    .               .
1031 c                 a4 .               . a2
1032 c                    .               .
1033 c                    .               .
1034 c                    .               .
1035 c                  n4*---------------*n3
1036 c                           a3
1037 c
1038       arsmed(tyhqu1,1,1) = 1
1039       arsmed(tyhqu1,1,2) = 4
1040       arsmed(tyhqu1,2,1) = 2
1041       arsmed(tyhqu1,2,2) = 1
1042       arsmed(tyhqu1,3,1) = 3
1043       arsmed(tyhqu1,3,2) = 2
1044       arsmed(tyhqu1,4,1) = 4
1045       arsmed(tyhqu1,4,2) = 3
1046 c
1047       deamed(tyhqu1,1,1) = 1
1048       deamed(tyhqu1,1,2) = 2
1049       deamed(tyhqu1,2,1) = 2
1050       deamed(tyhqu1,2,2) = 3
1051       deamed(tyhqu1,3,1) = 3
1052       deamed(tyhqu1,3,2) = 4
1053       deamed(tyhqu1,4,1) = 4
1054       deamed(tyhqu1,4,2) = 1
1055 c
1056 c 5.4.2. ==> complements pour le quadratique
1057 c                           a1/n5
1058 c                  n1*---------------*n2
1059 c                    .               .
1060 c                    .               .
1061 c                    .               .
1062 c              a4/n8 .               . a2/n6
1063 c                    .               .
1064 c                    .               .
1065 c                    .               .
1066 c                  n4*---------------*n3
1067 c                           a3/n7
1068 c
1069       deamed(tyhqu2,1,3) = 5
1070       deamed(tyhqu2,2,3) = 6
1071       deamed(tyhqu2,3,3) = 7
1072       deamed(tyhqu2,4,3) = 8
1073 c
1074       do 542 , iaux = 1, 4
1075         deamed(tyhqu3,iaux,3) = deamed(tyhqu2,iaux,3)
1076   542 continue
1077 c
1078 c 5.5. ==> description du tetraedre
1079 c
1080 c 5.5.1. ==> lineaire
1081 c                                    la face fi est opposee au sommet ni
1082 c
1083 c                     n1
1084 c                     *
1085 c                    .  ..
1086 c                   .     . . a2
1087 c                  .        .  .
1088 c                 .           .   .
1089 c             a1 .          a3  .    .  n3
1090 c               .                 .    *
1091 c              .                  . .   .
1092 c             .        a4    .        .  . a6
1093 c            .          .               . .
1094 c           .      .                      ..
1095 c          .  .                             .
1096 c         *..................................*
1097 c       n2               a5                  n4
1098 c
1099       arsmed(tyhte1,1,1) = 1
1100       arsmed(tyhte1,1,2) = 2
1101       arsmed(tyhte1,1,3) = 3
1102       arsmed(tyhte1,2,1) = 1
1103       arsmed(tyhte1,2,2) = 4
1104       arsmed(tyhte1,2,3) = 5
1105       arsmed(tyhte1,3,1) = 2
1106       arsmed(tyhte1,3,2) = 4
1107       arsmed(tyhte1,3,3) = 6
1108       arsmed(tyhte1,4,1) = 3
1109       arsmed(tyhte1,4,2) = 5
1110       arsmed(tyhte1,4,3) = 6
1111 c
1112       deamed(tyhte1,1,1) = 1
1113       deamed(tyhte1,1,2) = 2
1114       deamed(tyhte1,2,1) = 1
1115       deamed(tyhte1,2,2) = 3
1116       deamed(tyhte1,3,1) = 1
1117       deamed(tyhte1,3,2) = 4
1118       deamed(tyhte1,4,1) = 2
1119       deamed(tyhte1,4,2) = 3
1120       deamed(tyhte1,5,1) = 2
1121       deamed(tyhte1,5,2) = 4
1122       deamed(tyhte1,6,1) = 3
1123       deamed(tyhte1,6,2) = 4
1124 c
1125 c 5.5.2. ==> complements pour le quadratique
1126 c                                    la face fi est opposee au sommet ni
1127 c                     n1
1128 c                     *
1129 c                    .  ..
1130 c                   .     . . a2
1131 c                  .        .  *n7
1132 c                 .           .   .
1133 c             a1 .          a3  *    .  n3
1134 c             n5*               n8.    *
1135 c              .                  . .   .
1136 c             .        a4    .        .  . a6
1137 c            .          *n6             . *n10
1138 c           .      .                      ..
1139 c          .  .                             .
1140 c         *................*.................*
1141 c       n2              a5 n9                n4
1142 c
1143 c
1144       deamed(tyhte2,1,3) = 5
1145       deamed(tyhte2,2,3) = 7
1146       deamed(tyhte2,3,3) = 8
1147       deamed(tyhte2,4,3) = 6
1148       deamed(tyhte2,5,3) = 9
1149       deamed(tyhte2,6,3) = 10
1150 c
1151 c 5.6. ==> description de l'hexaedre
1152 c
1153 c 5.6.1. ==> lineaire
1154 c
1155 c             1                   4
1156 c             --------------------
1157 c            /                   /.
1158 c           /                   / .
1159 c          /                   /  .
1160 c         /                   /   .
1161 c       2 -------------------- 3  .
1162 c         .                  .    .
1163 c         .                  .    .
1164 c         .    5             .    . 8
1165 c         .                  .   /
1166 c         .                  .  /
1167 c         .                  . /
1168 c         .                  ./
1169 c         --------------------
1170 c         6                  7
1171 c
1172 c    . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
1173 c      vers l'exterieur
1174 c    . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
1175 c    . Le triedre (1-->2,1-->5,1-->4) est direct
1176 c
1177       arsmed(tyhhe1,1,1) = 1
1178       arsmed(tyhhe1,1,2) = 2
1179       arsmed(tyhhe1,1,3) = 5
1180       arsmed(tyhhe1,2,1) = 1
1181       arsmed(tyhhe1,2,2) = 3
1182       arsmed(tyhhe1,2,3) = 6
1183       arsmed(tyhhe1,3,1) = 3
1184       arsmed(tyhhe1,3,2) = 4
1185       arsmed(tyhhe1,3,3) = 8
1186       arsmed(tyhhe1,4,1) = 2
1187       arsmed(tyhhe1,4,2) = 4
1188       arsmed(tyhhe1,4,3) = 7
1189       arsmed(tyhhe1,5,1) = 5
1190       arsmed(tyhhe1,5,2) = 9
1191       arsmed(tyhhe1,5,3) = 10
1192       arsmed(tyhhe1,6,1) = 6
1193       arsmed(tyhhe1,6,2) = 9
1194       arsmed(tyhhe1,6,3) = 11
1195       arsmed(tyhhe1,7,1) = 8
1196       arsmed(tyhhe1,7,2) = 11
1197       arsmed(tyhhe1,7,3) = 12
1198       arsmed(tyhhe1,8,1) = 7
1199       arsmed(tyhhe1,8,2) = 10
1200       arsmed(tyhhe1,8,3) = 12
1201 c
1202       deamed(tyhhe1,1,1) = 1
1203       deamed(tyhhe1,1,2) = 2
1204       deamed(tyhhe1,2,1) = 1
1205       deamed(tyhhe1,2,2) = 4
1206       deamed(tyhhe1,3,1) = 2
1207       deamed(tyhhe1,3,2) = 3
1208       deamed(tyhhe1,4,1) = 3
1209       deamed(tyhhe1,4,2) = 4
1210       deamed(tyhhe1,5,1) = 1
1211       deamed(tyhhe1,5,2) = 5
1212       deamed(tyhhe1,6,1) = 2
1213       deamed(tyhhe1,6,2) = 6
1214       deamed(tyhhe1,7,1) = 4
1215       deamed(tyhhe1,7,2) = 8
1216       deamed(tyhhe1,8,1) = 3
1217       deamed(tyhhe1,8,2) = 7
1218       deamed(tyhhe1,9,1) = 5
1219       deamed(tyhhe1,9,2) = 6
1220       deamed(tyhhe1,10,1) = 5
1221       deamed(tyhhe1,10,2) = 8
1222       deamed(tyhhe1,11,1) = 6
1223       deamed(tyhhe1,11,2) = 7
1224       deamed(tyhhe1,12,1) = 7
1225       deamed(tyhhe1,12,2) = 8
1226 c
1227 c 5.6.2. ==> complements pour le quadratique
1228 c
1229 c             1                   4
1230 c             ---------12---------
1231 c            /                   /.
1232 c          9/                   11.
1233 c          /                   /  .
1234 c         /   17              /   .
1235 c       2 ---------10---------3   20
1236 c         .                  .    .
1237 c         .                  .    .
1238 c         .    5       16    .    . 8
1239 c       18.                  .19 /
1240 c         .  13              .  /15
1241 c         .                  . /
1242 c         .                  ./
1243 c         ---------14---------
1244 c         6                  7
1245 c
1246 c    . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
1247 c      vers l'exterieur
1248 c    . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
1249 c    . Le triedre (1-->2,1-->5,1-->4) est direct
1250 c
1251       deamed(tyhhe2,1,3) = 9
1252       deamed(tyhhe2,2,3) = 12
1253       deamed(tyhhe2,3,3) = 10
1254       deamed(tyhhe2,4,3) = 11
1255       deamed(tyhhe2,5,3) = 17
1256       deamed(tyhhe2,6,3) = 18
1257       deamed(tyhhe2,7,3) = 20
1258       deamed(tyhhe2,8,3) = 19
1259       deamed(tyhhe2,9,3) = 13
1260       deamed(tyhhe2,10,3) = 16
1261       deamed(tyhhe2,11,3) = 14
1262       deamed(tyhhe2,12,3) = 15
1263 c
1264       do 562 , iaux = 1, 12
1265         deamed(tyhhe3,iaux,3) = deamed(tyhhe2,iaux,3)
1266   562 continue
1267 c
1268 c 5.7. ==> Les pentaedres
1269 c
1270 c    . Les noeuds (1,2,3) definissent un triangle a orientation
1271 c      vers l'exterieur
1272 c    . Les noeuds (4,5,6,) sont translates de (1,2,3)
1273 c
1274 c 5.7.1. ==> Les lineaires
1275 c      la face (n1,n2,n3) tourne vers l'exterieur
1276 c      la face (n4,n5,n6) est translatee, donc tourne vers l'interieur
1277 c          n3                                          n6
1278 c           x------------------------------------------x
1279 c          .                                          .
1280 c         .  .                                       .  .
1281 c        .                                          .
1282 c       .     .                                    .     .
1283 c      .                                          .
1284 c     .        .                                 .        .
1285 c    .                                          .
1286 c n2.           .                            n5.           .
1287 c  x------------------------------------------x
1288 c     .          .                               .          .
1289 c          .                                          .
1290 c              .  .                                       .  .
1291 c                  x------------------------------------------x
1292 c                 n1                                          n4
1293 c
1294       arsmed(tyhpe1,1,1) = 1
1295       arsmed(tyhpe1,1,2) = 2
1296       arsmed(tyhpe1,1,3) = 7
1297       arsmed(tyhpe1,2,1) = 1
1298       arsmed(tyhpe1,2,2) = 3
1299       arsmed(tyhpe1,2,3) = 9
1300       arsmed(tyhpe1,3,1) = 2
1301       arsmed(tyhpe1,3,2) = 3
1302       arsmed(tyhpe1,3,3) = 8
1303       arsmed(tyhpe1,4,1) = 4
1304       arsmed(tyhpe1,4,2) = 5
1305       arsmed(tyhpe1,4,3) = 7
1306       arsmed(tyhpe1,5,1) = 4
1307       arsmed(tyhpe1,5,2) = 6
1308       arsmed(tyhpe1,5,3) = 9
1309       arsmed(tyhpe1,6,1) = 5
1310       arsmed(tyhpe1,6,2) = 6
1311       arsmed(tyhpe1,6,3) = 8
1312 c
1313       deamed(tyhpe1,1,1) = 1
1314       deamed(tyhpe1,1,2) = 2
1315       deamed(tyhpe1,2,1) = 1
1316       deamed(tyhpe1,2,2) = 3
1317       deamed(tyhpe1,3,1) = 2
1318       deamed(tyhpe1,3,2) = 3
1319       deamed(tyhpe1,4,1) = 4
1320       deamed(tyhpe1,4,2) = 5
1321       deamed(tyhpe1,5,1) = 4
1322       deamed(tyhpe1,5,2) = 6
1323       deamed(tyhpe1,6,1) = 5
1324       deamed(tyhpe1,6,2) = 6
1325       deamed(tyhpe1,7,1) = 1
1326       deamed(tyhpe1,7,2) = 4
1327       deamed(tyhpe1,8,1) = 3
1328       deamed(tyhpe1,8,2) = 6
1329       deamed(tyhpe1,9,1) = 2
1330       deamed(tyhpe1,9,2) = 5
1331 c
1332 c 5.7.2  Les quadratiques
1333 c      la face (n1,n2,n3) tourne vers l'exterieur
1334 c      la face (n4,n5,n6) est translatee, donc tourne vers l'interieur
1335 c          n3                      n15                 n6
1336 c           x------------------------------------------x
1337 c          .                                          .
1338 c         .  .                                       .  .
1339 c        .                                          .
1340 c     n8.     .                                 n11.     .
1341 c      .                                          .
1342 c     .        .                                 .        .
1343 c    .          n9                              .           n12
1344 c n2.           .          n14               n5.           .
1345 c  x------------------------------------------x
1346 c     .          .                               .          .
1347 c          .                                      n10 .
1348 c              .  .                                       .  .
1349 c        n7        x------------------------------------------x
1350 c                 n1                      n13                 n4
1351 c
1352       deamed(tyhpe2,1,3) = 7
1353       deamed(tyhpe2,2,3) = 9
1354       deamed(tyhpe2,3,3) = 8
1355       deamed(tyhpe2,4,3) = 10
1356       deamed(tyhpe2,5,3) = 12
1357       deamed(tyhpe2,6,3) = 11
1358       deamed(tyhpe2,7,3) = 13
1359       deamed(tyhpe2,8,3) = 15
1360       deamed(tyhpe2,9,3) = 14
1361 c
1362 c 5.8. ==> description de la pyramide
1363 c
1364 c 5.8.1. ==> lineaire
1365 c
1366 c       1 ----------------- 2
1367 c         . .           . .
1368 c         .   .       .   .
1369 c         .     .   .     .
1370 c         .       . 5     .  Ici le noeud 5 est au-dessus
1371 c         .     .   .     .
1372 c         .   .       .   .
1373 c         . .           . .
1374 c         -----------------
1375 c         4                3
1376 c
1377 c    . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
1378 c      vers l'exterieur
1379 c    . Le triedre (1-->2,1-->4,1-->5) est direct
1380 c
1381       arsmed(tyhpy1,1,1) = 1
1382       arsmed(tyhpy1,1,2) = 5
1383       arsmed(tyhpy1,1,3) = 8
1384       arsmed(tyhpy1,2,1) = 4
1385       arsmed(tyhpy1,2,2) = 7
1386       arsmed(tyhpy1,2,3) = 8
1387       arsmed(tyhpy1,3,1) = 3
1388       arsmed(tyhpy1,3,2) = 6
1389       arsmed(tyhpy1,3,3) = 7
1390       arsmed(tyhpy1,4,1) = 2
1391       arsmed(tyhpy1,4,2) = 5
1392       arsmed(tyhpy1,4,3) = 6
1393       arsmed(tyhpy1,5,1) = 1
1394       arsmed(tyhpy1,5,2) = 2
1395       arsmed(tyhpy1,5,3) = 3
1396       arsmed(tyhpy1,5,4) = 4
1397 c
1398       deamed(tyhpy1,1,1) = 1
1399       deamed(tyhpy1,1,2) = 5
1400       deamed(tyhpy1,2,1) = 4
1401       deamed(tyhpy1,2,2) = 5
1402       deamed(tyhpy1,3,1) = 3
1403       deamed(tyhpy1,3,2) = 5
1404       deamed(tyhpy1,4,1) = 2
1405       deamed(tyhpy1,4,2) = 5
1406       deamed(tyhpy1,5,1) = 1
1407       deamed(tyhpy1,5,2) = 4
1408       deamed(tyhpy1,6,1) = 3
1409       deamed(tyhpy1,6,2) = 4
1410       deamed(tyhpy1,7,1) = 2
1411       deamed(tyhpy1,7,2) = 3
1412       deamed(tyhpy1,8,1) = 1
1413       deamed(tyhpy1,8,2) = 2
1414 c
1415 c 5.8.2. ==> complements pour le quadratique
1416 c
1417 c       1 ----------------- 2
1418 c         . .           . .
1419 c         .   .       .   .
1420 c         .     .   .     .
1421 c         .       . 5     .  Ici le noeud 5 est au-dessus
1422 c         .     .   .     .
1423 c         .   .       .   .
1424 c         . .           . .
1425 c         -----------------
1426 c         4                3
1427 c
1428 c    . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
1429 c      vers l'exterieur
1430 c    . Le triedre (1-->2,1-->4,1-->5) est direct
1431 c
1432       deamed(tyhpy2,1,3) = 10
1433       deamed(tyhpy2,2,3) = 13
1434       deamed(tyhpy2,3,3) = 12
1435       deamed(tyhpy2,4,3) = 11
1436       deamed(tyhpy2,5,3) = 9
1437       deamed(tyhpy2,6,3) = 8
1438       deamed(tyhpy2,7,3) = 7
1439       deamed(tyhpy2,8,3) = 6
1440 c
1441 c 5.9 ==> En quadratique
1442 c
1443       do 591 , jaux = 1 , 10
1444 c
1445         arsmed(tyhse2,jaux,1) = arsmed(tyhse1,jaux,1)
1446         arsmed(tyhse2,jaux,2) = arsmed(tyhse1,jaux,2)
1447         arsmed(tyhse2,jaux,3) = arsmed(tyhse1,jaux,3)
1448 c
1449         arsmed(tyhtr2,jaux,1) = arsmed(tyhtr1,jaux,1)
1450         arsmed(tyhtr2,jaux,2) = arsmed(tyhtr1,jaux,2)
1451         arsmed(tyhtr2,jaux,3) = arsmed(tyhtr1,jaux,3)
1452 c
1453         arsmed(tyhtr3,jaux,1) = arsmed(tyhtr1,jaux,1)
1454         arsmed(tyhtr3,jaux,2) = arsmed(tyhtr1,jaux,2)
1455         arsmed(tyhtr3,jaux,3) = arsmed(tyhtr1,jaux,3)
1456 c
1457         arsmed(tyhte2,jaux,1) = arsmed(tyhte1,jaux,1)
1458         arsmed(tyhte2,jaux,2) = arsmed(tyhte1,jaux,2)
1459         arsmed(tyhte2,jaux,3) = arsmed(tyhte1,jaux,3)
1460 c
1461         arsmed(tyhqu2,jaux,1) = arsmed(tyhqu1,jaux,1)
1462         arsmed(tyhqu2,jaux,2) = arsmed(tyhqu1,jaux,2)
1463         arsmed(tyhqu2,jaux,3) = arsmed(tyhqu1,jaux,3)
1464 c
1465         arsmed(tyhqu3,jaux,1) = arsmed(tyhqu1,jaux,1)
1466         arsmed(tyhqu3,jaux,2) = arsmed(tyhqu1,jaux,2)
1467         arsmed(tyhqu3,jaux,3) = arsmed(tyhqu1,jaux,3)
1468 c
1469         arsmed(tyhpy2,jaux,1) = arsmed(tyhpy1,jaux,1)
1470         arsmed(tyhpy2,jaux,2) = arsmed(tyhpy1,jaux,2)
1471         arsmed(tyhpy2,jaux,3) = arsmed(tyhpy1,jaux,3)
1472         arsmed(tyhpy2,jaux,4) = arsmed(tyhpy1,jaux,4)
1473 c
1474         arsmed(tyhhe2,jaux,1) = arsmed(tyhhe1,jaux,1)
1475         arsmed(tyhhe2,jaux,2) = arsmed(tyhhe1,jaux,2)
1476         arsmed(tyhhe2,jaux,3) = arsmed(tyhhe1,jaux,3)
1477 c
1478         arsmed(tyhhe3,jaux,1) = arsmed(tyhhe1,jaux,1)
1479         arsmed(tyhhe3,jaux,2) = arsmed(tyhhe1,jaux,2)
1480         arsmed(tyhhe3,jaux,3) = arsmed(tyhhe1,jaux,3)
1481 c
1482         arsmed(tyhpe2,jaux,1) = arsmed(tyhpe1,jaux,1)
1483         arsmed(tyhpe2,jaux,2) = arsmed(tyhpe1,jaux,2)
1484         arsmed(tyhpe2,jaux,3) = arsmed(tyhpe1,jaux,3)
1485 c
1486   591 continue
1487 c
1488       do 592 , jaux = 1 , 12
1489 c
1490         deamed(tyhse2,jaux,1) = deamed(tyhse1,jaux,1)
1491         deamed(tyhse2,jaux,2) = deamed(tyhse1,jaux,2)
1492 c
1493         deamed(tyhtr2,jaux,1) = deamed(tyhtr1,jaux,1)
1494         deamed(tyhtr2,jaux,2) = deamed(tyhtr1,jaux,2)
1495 c
1496         deamed(tyhtr3,jaux,1) = deamed(tyhtr1,jaux,1)
1497         deamed(tyhtr3,jaux,2) = deamed(tyhtr1,jaux,2)
1498 c
1499         deamed(tyhqu2,jaux,1) = deamed(tyhqu1,jaux,1)
1500         deamed(tyhqu2,jaux,2) = deamed(tyhqu1,jaux,2)
1501 c
1502         deamed(tyhqu3,jaux,1) = deamed(tyhqu1,jaux,1)
1503         deamed(tyhqu3,jaux,2) = deamed(tyhqu1,jaux,2)
1504 c
1505         deamed(tyhte2,jaux,1) = deamed(tyhte1,jaux,1)
1506         deamed(tyhte2,jaux,2) = deamed(tyhte1,jaux,2)
1507 c
1508         deamed(tyhpy2,jaux,1) = deamed(tyhpy1,jaux,1)
1509         deamed(tyhpy2,jaux,2) = deamed(tyhpy1,jaux,2)
1510 c
1511         deamed(tyhhe2,jaux,1) = deamed(tyhhe1,jaux,1)
1512         deamed(tyhhe2,jaux,2) = deamed(tyhhe1,jaux,2)
1513 c
1514         deamed(tyhhe3,jaux,1) = deamed(tyhhe1,jaux,1)
1515         deamed(tyhhe3,jaux,2) = deamed(tyhhe1,jaux,2)
1516 c
1517         deamed(tyhpe2,jaux,1) = deamed(tyhpe1,jaux,1)
1518         deamed(tyhpe2,jaux,2) = deamed(tyhpe1,jaux,2)
1519 c
1520   592 continue
1521 c
1522 c====
1523 c 6. la fin
1524 c====
1525 c
1526       if ( codret.ne.0 ) then
1527 c
1528 #include "envex2.h"
1529         write (ulsort,texte(langue,1)) 'Sortie', nompro
1530         write (ulsort,texte(langue,2)) codret
1531       endif
1532 c
1533 #ifdef _DEBUG_HOMARD_
1534       write (ulsort,texte(langue,1)) 'Sortie', nompro
1535       call dmflsh (iaux)
1536 #endif
1537 c
1538       end