src/tool/Creation_Maillage/cmrdte.F

   1       subroutine cmrdte ( coonoe, somare, hetare, filare,
   2      >                    merare, aretri, hettri,
   3      >                    filtri, pertri, nivtri,
   4      >                    tritet, cotrte, hettet, filtet,
   5      >                    pertet,
   6      >                    famare, famtri, famtet,
   7      >                    indare, indtri, indtet,
   8      >                    ulsort, langue, codret )
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c    Creation du Maillage - Raffinement - Decoupage des TEtraedres
  30 c    -           -          -             -             --
  31 c ______________________________________________________________________
  32 c       remarque : on est forcement en 3d
  33 c ______________________________________________________________________
  34 c .        .     .        .                                            .
  35 c .  nom   . e/s . taille .           description                      .
  36 c .____________________________________________________________________.
  37 c . coonoe . e   .nouvno*3. coordonnees des noeuds                     .
  38 c . somare . es  .2*nouvar. numeros des extremites d'arete             .
  39 c . hetare . es  . nouvar . historique de l'etat des aretes            .
  40 c . filare . es  . nouvar . premiere fille des aretes                  .
  41 c . merare . es  . nouvar . mere des aretes                            .
  42 c . aretri . e   .nouvtr*3. numeros des 3 aretes des triangles         .
  43 c . hettri . e   . nouvtr . historique de l'etat des triangles         .
  44 c . filtri . e   . nouvtr . premier fils des triangles                 .
  45 c . pertri . e   . nouvtr . pere des triangles                         .
  46 c . nivtri . e   . nouvtr . niveau des triangles                       .
  47 c . tritet . e   .nouvtf*4. numeros des 4 triangles des tetraedres     .
  48 c . cotrte . e   .nouvtf*4. code des 4 triangles des tetraedres        .
  49 c . hettet . es  . nouvte . historique de l'etat des tetraedres        .
  50 c . filtet . es  . nouvte . premier fils des tetraedres                .
  51 c . pertet . e   . nouvte . pere des tetraedres                        .
  52 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  53 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  54 c . famare . es  . nouvar . famille des aretes                         .
  55 c . famtri . es  . nouvtr . famille des triangles                      .
  56 c . famtet . e   . nouvte . famille des tetraedres                     .
  57 c . indare . es  . 1      . indice de la derniere arete creee          .
  58 c . indtri . es  . 1      . indice du dernier triangle cree            .
  59 c . indtet . es  . 1      . indice du dernier tetraedre cree           .
  60 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  61 c . langue . e   .    1   . langue des messages                        .
  62 c .        .     .        . 1 : francais, 2 : anglais                  .
  63 c . codret . es  .    1   . code de retour des modules                 .
  64 c .        .     .        . 0 : pas de probleme                        .
  65 c ______________________________________________________________________
  66 c
  67 c====
  68 c 0. declarations et dimensionnement
  69 c====
  70 c
  71 c 0.1. ==> generalites
  72 c
  73       implicit none
  74       save
  75 c
  76       character*6 nompro
  77       parameter ( nompro = 'CMRDTE' )
  78 c
  79 #include "nblang.h"
  80 c
  81 c 0.2. ==> communs
  82 c
  83 #include "envex1.h"
  84 #include "envca1.h"
  85 #include "i1i2i3.h"
  86 #include "nombte.h"
  87 #include "nouvnb.h"
  88 #include "permut.h"
  89 #include "impr02.h"
  90 c
  91 c 0.3. ==> arguments
  92 c
  93       double precision coonoe(nouvno,sdim)
  94 c
  95       integer somare(2,nouvar), hetare(nouvar), filare(nouvar)
  96       integer merare(nouvar), aretri(nouvtr,3)
  97       integer hettri(nouvtr), filtri(nouvtr), pertri(nouvtr)
  98       integer nivtri(nouvtr)
  99       integer tritet(nouvtf,4), cotrte(nouvtf,4)
 100       integer hettet(nouvte), filtet(nouvte), pertet(nouvte)
 101       integer famare(nouvar), famtri(nouvtr), famtet(nouvte)
 102       integer indare, indtri, indtet
 103 c
 104       integer ulsort, langue, codret
 105 c
 106 c 0.4. ==> variables locales
 107 c
 108       integer adiag, dt, etat, letetr, nudiag, pere, typdia
 109       integer niveau, cf1, cf2, cf3, cf4, f1, f2, f3, f4
 110       integer codefa, codef1, codef2, codef3, codef4
 111       integer a4ff1, a5ff1, a6ff1, a2ff2, a3ff2, a6ff2
 112       integer a1ff3, a3ff3, a5ff3, a1ff4, a2ff4, a4ff4
 113       integer as1n1, as1n2, as1n3, as2n4, as2n5, as3n6
 114       integer ff1, ff2, ff3, ff4, n1, n2, n3, n4, n5, n6
 115       integer f4ff1, f5ff1, f6ff1, f2ff2, f3ff2, f6ff2
 116       integer f1ff3, f3ff3, f5ff3, f1ff4, f2ff4, f4ff4
 117       integer fparf1, fparf2, fparf3, fparf4
 118       integer fd16n2, fd16n3, fd16n4, fd16n5
 119       integer fd25n1, fd25n3, fd25n4, fd25n6
 120       integer fd34n1, fd34n2, fd34n5, fd34n6
 121       integer tparf1, tparf2, tparf3, tparf4
 122       integer t16ff1, t16ff2, t16ff3, t16ff4
 123       integer t25ff1, t25ff2, t25ff3, t25ff4
 124       integer t34ff1, t34ff2, t34ff3, t34ff4
 125 c
 126       integer iaux, jaux
 127 c
 128       double precision long16, long25, long34, xdiag, ydiag, zdiag
 129 c
 130       integer nbmess
 131       parameter ( nbmess = 10 )
 132       character*80 texte(nblang,nbmess)
 133 c
 134 c 0.5. ==> initialisations
 135 c ______________________________________________________________________
 136 c
 137 c====
 138 c 1. preliminaires
 139 c====
 140 c
 141 c 1.1. ==> messages
 142 c
 143 #include "impr01.h"
 144 c
 145 #ifdef _DEBUG_HOMARD_
 146       write (ulsort,texte(langue,1)) 'Entree', nompro
 147       call dmflsh (iaux)
 148 #endif
 149 c
 150       texte(1,4) = '(''Decoupage du '',a,i10)'
 151 c
 152       texte(2,4) = '(''Splitting of '',a,'' #'',i10)'
 153 c
 154 c====
 155 c 2. decoupage en 8 des tetraedres dont les 4 faces sont coupees en 4
 156 c====
 157 c
 158       do 200 , letetr = 1 , nbtepe
 159 c
 160        if ( mod( hettet(letetr) , 100 ) .eq. 0 ) then
 161 c
 162 c 2.1. decoupage ?
 163 c
 164         dt = 0
 165         do 21 , iaux = 1 , 4
 166           jaux = tritet(letetr,iaux)
 167           if ( mod(hettri(jaux),10).eq.4 .or.
 168      >         mod(hettri(jaux),10).eq.5 .or.
 169      >         mod(hettri(jaux),10).eq.6 .or.
 170      >         mod(hettri(jaux),10).eq.7 .or.
 171      >         mod(hettri(jaux),10).eq.9) then
 172             dt = dt + 1
 173           endif
 174    21   continue
 175 c
 176         if ( dt.eq.4 ) then
 177 #ifdef _DEBUG_HOMARD_
 178       write (ulsort,texte(langue,4)) mess14(langue,1,3), letetr
 179 #endif
 180 c
 181 c 2.2. ==> description des 4 faces du tetraedre
 182 c
 183 c 2.2.1. ==> description de la face 1
 184 c
 185           f1 = tritet(letetr,1)
 186           cf1 = cotrte(letetr,1)
 187 c
 188 c 2.2.1.1. ==> reperage des 4 triangles fils
 189 c
 190           ff1 = filtri(f1)
 191           f4ff1 = ff1 + i1(cf1)
 192           f5ff1 = ff1 + i2(cf1)
 193           f6ff1 = ff1 + i3(cf1)
 194 c
 195 c 2.2.1.2. ==> reperage des 3 aretes internes
 196 c
 197           a4ff1 = aretri(ff1,i1(cf1))
 198           a5ff1 = aretri(ff1,i2(cf1))
 199           a6ff1 = aretri(ff1,i3(cf1))
 200 c
 201 c 2.2.2. ==> description de la face 2
 202 c
 203           f2 = tritet(letetr,2)
 204           cf2 = cotrte(letetr,2)
 205 c
 206 c 2.2.2.1. ==> reperage des 4 triangles fils
 207 c
 208           ff2 = filtri(f2)
 209           f2ff2 = ff2 + i1(cf2)
 210           f3ff2 = ff2 + i2(cf2)
 211           f6ff2 = ff2 + i3(cf2)
 212 c
 213 c 2.2.2.2. ==> reperage des 3 aretes internes
 214 c
 215           a2ff2 = aretri(ff2,i1(cf2))
 216           a3ff2 = aretri(ff2,i2(cf2))
 217           a6ff2 = aretri(ff2,i3(cf2))
 218 c
 219 c 2.2.3. ==> description de la face 3
 220 c
 221           f3 = tritet(letetr,3)
 222           cf3 = cotrte(letetr,3)
 223 c
 224 c 2.2.3.1. ==> reperage des 4 triangles fils
 225 c
 226           ff3 = filtri(f3)
 227           f1ff3 = ff3 + i1(cf3)
 228           f3ff3 = ff3 + i2(cf3)
 229           f5ff3 = ff3 + i3(cf3)
 230 c
 231 c 2.2.3.2. ==> reperage des 3 aretes internes
 232 c
 233           a1ff3 = aretri(ff3,i1(cf3))
 234           a3ff3 = aretri(ff3,i2(cf3))
 235           a5ff3 = aretri(ff3,i3(cf3))
 236 c
 237 c 2.2.4. ==> description de la face 4
 238 c
 239           f4 = tritet(letetr,4)
 240           cf4 = cotrte(letetr,4)
 241 c
 242 c 2.2.4.1. ==> reperage des 4 triangles fils
 243 c
 244           ff4 = filtri(f4)
 245           f1ff4 = ff4 + i1(cf4)
 246           f2ff4 = ff4 + i2(cf4)
 247           f4ff4 = ff4 + i3(cf4)
 248 c
 249 c 2.2.4.2. ==> reperage des 3 aretes internes
 250 c
 251           a1ff4 = aretri(ff4,i1(cf4))
 252           a2ff4 = aretri(ff4,i2(cf4))
 253           a4ff4 = aretri(ff4,i3(cf4))
 254 c
 255 c 2.3. ==> reperage des noeuds milieux des aretes
 256 c
 257           as1n1 = aretri(f5ff3,i1(cf3))
 258           as1n2 = aretri(f6ff2,i1(cf2))
 259           as1n3 = aretri(f6ff2,i2(cf2))
 260           as2n4 = aretri(f6ff1,i1(cf1))
 261           as2n5 = aretri(f6ff1,i2(cf1))
 262           as3n6 = aretri(f5ff1,i3(cf1))
 263 c
 264           n1 = somare(2,as1n1)
 265           n2 = somare(2,as1n2)
 266           n3 = somare(2,as1n3)
 267           n4 = somare(2,as2n4)
 268           n5 = somare(2,as2n5)
 269           n6 = somare(2,as3n6)
 270 c
 271 c 2.4. ==> calcul des longueurs des diagonales et choix
 272 c          de la plus petite
 273 c
 274           xdiag = coonoe(n1,1) - coonoe(n6,1)
 275           ydiag = coonoe(n1,2) - coonoe(n6,2)
 276           zdiag = coonoe(n1,3) - coonoe(n6,3)
 277           long16 = xdiag * xdiag + ydiag * ydiag + zdiag * zdiag
 278           xdiag = coonoe(n2,1) - coonoe(n5,1)
 279           ydiag = coonoe(n2,2) - coonoe(n5,2)
 280           zdiag = coonoe(n2,3) - coonoe(n5,3)
 281           long25 = xdiag * xdiag + ydiag * ydiag + zdiag * zdiag
 282           xdiag = coonoe(n3,1) - coonoe(n4,1)
 283           ydiag = coonoe(n3,2) - coonoe(n4,2)
 284           zdiag = coonoe(n3,3) - coonoe(n4,3)
 285           long34 = xdiag * xdiag + ydiag * ydiag + zdiag * zdiag
 286 c
 287           if ( long16 .le. long25 ) then
 288             if ( long16 .le. long34 ) then
 289               nudiag = 16
 290               typdia = 5
 291             else
 292               nudiag = 34
 293               typdia = 7
 294             endif
 295           else
 296             if ( long25 .le. long34 ) then
 297               nudiag = 25
 298               typdia = 6
 299             else
 300               nudiag = 34
 301               typdia = 7
 302             endif
 303           endif
 304 c
 305 c 2.5. ==> creation de l'arete diagonale
 306 c
 307           adiag = indare + 1
 308           indare = adiag
 309 c
 310           if ( nudiag .eq. 16 ) then
 311             somare(1,adiag) = min ( n1 , n6 )
 312             somare(2,adiag) = max ( n1 , n6 )
 313           elseif ( nudiag .eq. 25 ) then
 314             somare(1,adiag) = min ( n2 , n5 )
 315             somare(2,adiag) = max ( n2 , n5 )
 316           else
 317             somare(1,adiag) = min ( n3 , n4 )
 318             somare(2,adiag) = max ( n3 , n4 )
 319           endif
 320 c
 321           famare(adiag) = 1
 322 c
 323           hetare(adiag) = 50
 324           merare(adiag) = 0
 325           filare(adiag) = 0
 326 c
 327 c 2.6. ==> creation des faces
 328 c
 329 c 2.6.1. ==> recuperation du niveau commun a tous les triangles fils
 330 c
 331           niveau = nivtri(ff1)
 332 c
 333 c 2.6.2. ==> creation des 4 faces d'angle
 334 c
 335           fparf1 = indtri + 1
 336           call cmctri ( aretri, famtri, hettri,
 337      >                  filtri, pertri, nivtri,
 338      >                  fparf1, a4ff4, a5ff3, a6ff2,
 339      >                  cf1, niveau )
 340 c
 341           fparf2 = indtri + 2
 342           call cmctri ( aretri, famtri, hettri,
 343      >                  filtri, pertri, nivtri,
 344      >                  fparf2, a2ff4, a3ff3, a6ff1,
 345      >                  cf2, niveau )
 346 c
 347           fparf3 = indtri + 3
 348           call cmctri ( aretri, famtri, hettri,
 349      >                  filtri, pertri, nivtri,
 350      >                  fparf3, a1ff4, a3ff2, a5ff1,
 351      >                  cf3, niveau )
 352 c
 353           fparf4 = indtri + 4
 354           call cmctri ( aretri, famtri, hettri,
 355      >                  filtri, pertri, nivtri,
 356      >                  fparf4, a1ff3, a2ff2, a4ff1,
 357      >                  cf4, niveau )
 358 c
 359 c 2.6.3 ==> creation des 4 faces internes en fonction de la diagonale
 360 c
 361 c         tous ces triangles sont crees avec le code arbitraire 1
 362 c         et avec le meme niveau que les nouvelles 4 faces d'angle
 363 c
 364           codefa = 1
 365 c
 366           if ( nudiag .eq. 16 ) then
 367 c
 368             fd16n2 = indtri + 5
 369             call cmctri ( aretri, famtri, hettri,
 370      >                    filtri, pertri, nivtri,
 371      >                    fd16n2, adiag, a3ff2, a4ff4,
 372      >                    codefa, niveau )
 373 c
 374             fd16n3 = indtri + 6
 375             call cmctri ( aretri, famtri, hettri,
 376      >                    filtri, pertri, nivtri,
 377      >                    fd16n3, adiag, a2ff2, a5ff3,
 378      >                    codefa, niveau )
 379 c
 380             fd16n4 = indtri + 7
 381             call cmctri ( aretri, famtri, hettri,
 382      >                    filtri, pertri, nivtri,
 383      >                    fd16n4, adiag, a2ff4, a5ff1,
 384      >                    codefa, niveau )
 385 c
 386             fd16n5 = indtri + 8
 387             call cmctri ( aretri, famtri, hettri,
 388      >                    filtri, pertri, nivtri,
 389      >                    fd16n5, adiag, a3ff3, a4ff1,
 390      >                    codefa, niveau )
 391 c
 392             indtri = fd16n5
 393 c
 394           elseif ( nudiag .eq. 25 ) then
 395 c
 396             fd25n1 = indtri + 5
 397             call cmctri ( aretri, famtri, hettri,
 398      >                    filtri, pertri, nivtri,
 399      >                    fd25n1, adiag, a3ff3, a4ff4,
 400      >                    codefa, niveau )
 401 c
 402             fd25n3 = indtri + 6
 403             call cmctri ( aretri, famtri, hettri,
 404      >                    filtri, pertri, nivtri,
 405      >                    fd25n3, a1ff3, adiag, a6ff2,
 406      >                    codefa, niveau )
 407 c
 408             fd25n4 = indtri + 7
 409             call cmctri ( aretri, famtri, hettri,
 410      >                    filtri, pertri, nivtri,
 411      >                    fd25n4, adiag, a1ff4, a6ff1,
 412      >                    codefa, niveau )
 413 c
 414             fd25n6 = indtri + 8
 415             call cmctri ( aretri, famtri, hettri,
 416      >                    filtri, pertri, nivtri,
 417      >                    fd25n6, a3ff2, adiag, a4ff1,
 418      >                    codefa, niveau )
 419 c
 420             indtri = fd25n6
 421 c
 422           else
 423 c
 424             fd34n1 = indtri + 5
 425             call cmctri ( aretri, famtri, hettri,
 426      >                    filtri, pertri, nivtri,
 427      >                    fd34n1, adiag, a5ff3, a2ff4,
 428      >                    codefa, niveau )
 429 c
 430             fd34n2 = indtri + 6
 431             call cmctri ( aretri, famtri, hettri,
 432      >                    filtri, pertri, nivtri,
 433      >                    fd34n2, adiag, a1ff4, a6ff2,
 434      >                    codefa, niveau )
 435 c
 436             fd34n5 = indtri + 7
 437             call cmctri ( aretri, famtri, hettri,
 438      >                    filtri, pertri, nivtri,
 439      >                    fd34n5, a1ff3, adiag, a6ff1,
 440      >                    codefa, niveau )
 441 c
 442             fd34n6 = indtri + 8
 443             call cmctri ( aretri, famtri, hettri,
 444      >                    filtri, pertri, nivtri,
 445      >                    fd34n6, a2ff2, adiag, a5ff1,
 446      >                    codefa, niveau )
 447 c
 448             indtri = fd34n6
 449 c
 450           endif
 451 c
 452 c 2.7. ==> creation des tetraedres
 453 c
 454           iaux = famtet(letetr)
 455 c
 456 c 2.7.1. ==> creation des 4 tetraedres d'angle
 457 c
 458           tparf1 = indtet + 1
 459           call cmctet ( tritet, cotrte, famtet,
 460      >                  hettet, filtet, pertet,
 461      >                  fparf1, f6ff2,  f5ff3,  f4ff4,
 462      >                  cf1,    cf2,    cf3,    cf4,
 463      >                  letetr, iaux, tparf1 )
 464 c
 465           tparf2 = indtet + 2
 466           call cmctet ( tritet, cotrte, famtet,
 467      >                  hettet, filtet, pertet,
 468      >                  f6ff1,  fparf2, f3ff3,  f2ff4,
 469      >                  cf1,    cf2,    cf3,    cf4,
 470      >                  letetr, iaux, tparf2 )
 471 c
 472           tparf3 = indtet + 3
 473           call cmctet ( tritet, cotrte, famtet,
 474      >                  hettet, filtet, pertet,
 475      >                  f5ff1,  f3ff2,  fparf3, f1ff4,
 476      >                  cf1,    cf2,    cf3,    cf4,
 477      >                  letetr, iaux, tparf3 )
 478 c
 479           tparf4 = indtet + 4
 480           call cmctet ( tritet, cotrte, famtet,
 481      >                  hettet, filtet, pertet,
 482      >                  f4ff1,  f2ff2,  f1ff3,  fparf4,
 483      >                  cf1,    cf2,    cf3,    cf4,
 484      >                  letetr, iaux, tparf4 )
 485 c
 486 c 2.7.2. ==> creation des 4 tetraedres internes en fonction
 487 c            de la diagonale
 488 c
 489           if ( nudiag .eq. 16 ) then
 490 c ancien 1
 491             t16ff1 = indtet + 5
 492             codef1 = cf1
 493             codef2 = perm3(cf2)
 494             codef3 = 1
 495             codef4 = 1
 496             call cmctet ( tritet, cotrte, famtet,
 497      >                    hettet, filtet, pertet,
 498      >                    ff1,    fparf2, fd16n4, fd16n5,
 499      >                    codef1, codef2, codef3, codef4,
 500      >                    letetr, iaux, t16ff1 )
 501 c ancien 3
 502             t16ff3 = indtet + 7
 503             codef1 = 3
 504             codef2 = 5
 505             codef3 = cf3
 506             codef4 = perm1(cf4)
 507             call cmctet ( tritet, cotrte, famtet,
 508      >                    hettet, filtet, pertet,
 509      >                    fd16n3, fd16n5, ff3,    fparf4,
 510      >                    codef1, codef2, codef3, codef4,
 511      >                    letetr, iaux, t16ff3 )
 512 c ancien 2
 513             t16ff2 = indtet + 6
 514             codef1 = perm3(cf1)
 515             codef2 = cf2
 516             codef3 = 1
 517             codef4 = 1
 518             call cmctet ( tritet, cotrte, famtet,
 519      >                    hettet, filtet, pertet,
 520      >                    fparf1, ff2,    fd16n2, fd16n3,
 521      >                    codef1, codef2, codef3, codef4,
 522      >                    letetr, iaux, t16ff2 )
 523 c ancien 4
 524             t16ff4 = indtet + 8
 525             codef1 = 5
 526             codef2 = 3
 527             codef3 = perm1(cf3)
 528             codef4 = cf4
 529             call cmctet ( tritet, cotrte, famtet,
 530      >                    hettet, filtet, pertet,
 531      >                    fd16n2, fd16n4, fparf3, ff4,
 532      >                    codef1, codef2, codef3, codef4,
 533      >                    letetr, iaux, t16ff4 )
 534 c
 535             indtet = t16ff4
 536 c
 537           elseif ( nudiag .eq. 25 ) then
 538 c
 539             t25ff1 = indtet + 5
 540             codef1 = cf1
 541             codef2 = 1
 542             codef3 = perm3(cf3)
 543             codef4 = 1
 544             call cmctet ( tritet, cotrte, famtet,
 545      >                    hettet, filtet, pertet,
 546      >                    ff1,    fd25n4, fparf3, fd25n6,
 547      >                    codef1, codef2, codef3, codef4,
 548      >                    letetr, iaux, t25ff1 )
 549 c
 550             t25ff2 = indtet + 6
 551             codef1 = 1
 552             codef2 = cf2
 553             codef3 = 2
 554             codef4 = perm2(cf4)
 555             call cmctet ( tritet, cotrte, famtet,
 556      >                    hettet, filtet, pertet,
 557      >                    fd25n3, ff2,    fd25n6, fparf4,
 558      >                    codef1, codef2, codef3, codef4,
 559      >                    letetr, iaux, t25ff2 )
 560 c
 561             t25ff3 = indtet + 7
 562             codef1 = perm2(cf1)
 563             codef2 = 1
 564             codef3 = cf3
 565             codef4 = 1
 566             call cmctet ( tritet, cotrte, famtet,
 567      >                    hettet, filtet, pertet,
 568      >                    fparf1, fd25n1, ff3,    fd25n3,
 569      >                    codef1, codef2, codef3, codef4,
 570      >                    letetr, iaux, t25ff3 )
 571 c
 572             t25ff4 = indtet + 8
 573             codef1 = 2
 574             codef2 = perm1(cf2)
 575             codef3 = 3
 576             codef4 = cf4
 577             call cmctet ( tritet, cotrte, famtet,
 578      >                    hettet, filtet, pertet,
 579      >                    fd25n1, fparf2, fd25n4, ff4,
 580      >                    codef1, codef2, codef3, codef4,
 581      >                    letetr, iaux, t25ff4 )
 582 c
 583             indtet = t25ff4
 584 c
 585           else
 586 c ancien 1
 587             t34ff1 = indtet + 5
 588             codef1 = cf1
 589             codef2 = 1
 590             codef3 = 1
 591             codef4 = perm3(cf4)
 592             call cmctet ( tritet, cotrte, famtet,
 593      >                    hettet, filtet, pertet,
 594      >                    ff1,    fd34n5, fd34n6, fparf4,
 595      >                    codef1, codef2, codef3, codef4,
 596      >                    letetr, iaux, t34ff1 )
 597 c ancien 2
 598             t34ff2 = indtet + 6
 599             codef1 = 1
 600             codef2 = cf2
 601             codef3 = perm2(cf3)
 602             codef4 = 2
 603             call cmctet ( tritet, cotrte, famtet,
 604      >                    hettet, filtet, pertet,
 605      >                    fd34n2, ff2,    fparf3, fd34n6,
 606      >                    codef1, codef2, codef3, codef4,
 607      >                    letetr, iaux, t34ff2 )
 608 c ancien 4
 609             t34ff4 = indtet + 8
 610             codef1 = perm1(cf1)
 611             codef2 = 2
 612             codef3 = 6
 613             codef4 = cf4
 614             call cmctet ( tritet, cotrte, famtet,
 615      >                    hettet, filtet, pertet,
 616      >                    fparf1, fd34n1, fd34n2, ff4,
 617      >                    codef1, codef2, codef3, codef4,
 618      >                    letetr, iaux, t34ff4 )
 619 c ancien 3
 620             t34ff3 = indtet + 7
 621             codef1 = 1
 622             codef2 = perm2(cf2)
 623             codef3 = cf3
 624             codef4 = 4
 625             call cmctet ( tritet, cotrte, famtet,
 626      >                    hettet, filtet, pertet,
 627      >                    fd34n1, fparf2, ff3,    fd34n5,
 628      >                    codef1, codef2, codef3, codef4,
 629      >                    letetr, iaux, t34ff3 )
 630 c
 631             indtet = t34ff4
 632 c
 633           endif
 634 c
 635 c 2.7.3. ==> mise a jour du tetredre courant et de son pere eventuel
 636 c
 637           filtet(letetr) = tparf1
 638           hettet(letetr) = hettet(letetr) + 80 + typdia
 639           pere = pertet(letetr)
 640           if ( pere .ne. 0 ) then
 641             etat = hettet(pere)
 642             hettet(pere) = etat - mod(etat,100) + 99
 643           endif
 644 c
 645         endif
 646 c
 647        endif
 648 c
 649   200 continue
 650 c
 651 c====
 652 c 3. la fin
 653 c====
 654 c
 655       if ( codret.ne.0 ) then
 656 c
 657 #include "envex2.h"
 658 c
 659       write (ulsort,texte(langue,1)) 'Sortie', nompro
 660       write (ulsort,texte(langue,2)) codret
 661 c
 662       endif
 663 c
 664 #ifdef _DEBUG_HOMARD_
 665       write (ulsort,texte(langue,1)) 'Sortie', nompro
 666       call dmflsh (iaux)
 667 #endif
 668 c
 669       end