src/tool/Decision/dercon.F

   1       subroutine dercon ( tyconf, homolo, maconf,
   2      >                    decare, decfac,
   3      >                    hetare, filare, merare, arehom,
   4      >                    posifa, facare,
   5      >                    hettri, aretri,
   6      >                    filtri, pertri, nivtri, homtri,
   7      >                    voltri, pypetr,
   8      >                    hetqua, arequa,
   9      >                    filqua, perqua, nivqua, quahom,
  10      >                    volqua, pypequ,
  11      >                    hettet, tritet,
  12      >                    hethex, quahex, coquhe,
  13      >                    hetpyr, facpyr, cofapy,
  14      >                    hetpen, facpen, cofape,
  15      >                    listfa,
  16      >                    ulsort, langue, codret )
  17 c ______________________________________________________________________
  18 c
  19 c                             H O M A R D
  20 c
  21 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  22 c
  23 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  24 c aupres des huissiers de justice Simart et Lavoir a Clamart
  25 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  26 c aupres des huissiers de justice
  27 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  28 c
  29 c    HOMARD est une marque deposee d'Electricite de France
  30 c
  31 c Copyright EDF 1996
  32 c Copyright EDF 1998
  33 c Copyright EDF 2002
  34 c Copyright EDF 2020
  35 c ______________________________________________________________________
  36 c
  37 c traitement des DEcisions - Raffinement : CONtamination
  38 c                --          -             ---
  39 c ______________________________________________________________________
  40 c .        .     .        .                                            .
  41 c .  nom   . e/s . taille .           description                      .
  42 c .____________________________________________________________________.
  43 c . tyconf . e   .   1    .  0 : conforme (defaut)                     .
  44 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  45 c .        .     .        .      non decoupees en 2 par face           .
  46 c .        .     .        .  2 : non-conforme avec 1 seul noeud        .
  47 c .        .     .        .      pendant par arete                     .
  48 c .        .     .        .  3 : non-conforme fidele a l'indicateur    .
  49 c .        .     .        . -1 : conforme, avec des boites pour les    .
  50 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  51 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  52 c .        .     .        .      decoupee en 2 (boite pour les         .
  53 c .        .     .        .      quadrangles, hexaedres et pentaedres) .
  54 c . homolo . e   .   1    . presence d'homologue                       .
  55 c .        .     .        . 0 : non                                    .
  56 c .        .     .        . 1 : il existe des noeuds homologues        .
  57 c .        .     .        . 2 : il existe des aretes homologues        .
  58 c .        .     .        . 3 : il existe des faces homologues         .
  59 c . maconf . e   .    1   . conformite du maillage                     .
  60 c .        .     .        .  0 : oui                                   .
  61 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  62 c .        .     .        .      non decoupees en 2 par face           .
  63 c .        .     .        .  2 : non-conforme avec 1 seul noeud pendant.
  64 c .        .     .        .      par arete                             .
  65 c .        .     .        .  3 : non-conforme fidele a l'indicateur    .
  66 c .        .     .        . -1 : conforme, avec des boites pour les    .
  67 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  68 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  69 c .        .     .        .      decoupee en 2 et des boites pour les  .
  70 c .        .     .        .       quadrangles, hexaedres et pentaedres .
  71 c .        .     .        . 10 : non-conforme sans autre connaissance  .
  72 c . decare . es  . nbarto . decisions des aretes                       .
  73 c . decfac . es  . -nbquto. decision sur les faces (quad. + tri.)      .
  74 c .        .     . :nbtrto.                                            .
  75 c . hetare . e   . nbarto . historique de l'etat des aretes            .
  76 c . filare . e   . nbarto . premiere fille des aretes                  .
  77 c . merare . e   . nbarto . mere des aretes                            .
  78 c . arehom . e   . nbarto . ensemble des aretes homologues             .
  79 c . posifa . e   . nbarto . pointeur sur tableau facare                .
  80 c . facare . e   . nbfaar . liste des faces contenant une arete        .
  81 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
  82 c . aretri . e   . nbtrto . numeros des 3 aretes des triangles         .
  83 c . filtri . e   . nbtrto . premier fils des triangles                 .
  84 c . pertri . e   . nbtrto . pere des triangles                         .
  85 c . nivtri . e   . nbtrto . niveau des triangles                       .
  86 c . homtri . e   . nbtrto . ensemble des triangles homologues          .
  87 c . voltri . e   .2*nbtrto. numeros des 2 volumes par triangle         .
  88 c .        .     .        . voltri(i,k) definit le i-eme voisin de k   .
  89 c .        .     .        .   0 : pas de voisin                        .
  90 c .        .     .        . j>0 : tetraedre j                          .
  91 c .        .     .        . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
  92 c . pypetr . e   .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
  93 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  94 c .        .     .        . pypetr(2,j) = numero du pentaedre voisin   .
  95 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  96 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
  97 c . arequa . e   . nbquto . numeros des 4 aretes des quadrangles       .
  98 c . filqua . e   . nbquto . premier fils des quadrangles               .
  99 c . perqua . e   . nbquto . pere des quadrangles                       .
 100 c . nivqua . e   . nbquto . niveau des quadrangles                     .
 101 c . quahom . e   . nbquto . ensemble des quadrangles homologues        .
 102 c . volqua . e   .2*nbquto. numeros des 2 volumes par quadrangle       .
 103 c .        .     .        . volqua(i,k) definit le i-eme voisin de k   .
 104 c .        .     .        .   0 : pas de voisin                        .
 105 c .        .     .        . j>0 : hexaedre j                           .
 106 c .        .     .        . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
 107 c . pypequ . e   .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
 108 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 109 c .        .     .        . pypequ(2,j) = numero du pentaedre voisin   .
 110 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 111 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
 112 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
 113 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
 114 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
 115 c . coquhe . e   .nbhecf*6. codes des 6 quadrangles des hexaedres      .
 116 c . hetpyr . e   . nbpyto . historique de l'etat des pyramides         .
 117 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
 118 c . cofapy . e   .nbpycf*5. codes des faces des pyramides              .
 119 c . hetpen . e   . nbpeto . historique de l'etat des pentaedres        .
 120 c . facpen . e   .nbpecf*5. numeros des faces des pentaedres           .
 121 c . cofape . e   .nbpecf*5. code des 5 faces des pentaedres            .
 122 c . listfa . t   .   *    . liste de faces a considerer                .
 123 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 124 c . langue . e   .    1   . langue des messages                        .
 125 c .        .     .        . 1 : francais, 2 : anglais                  .
 126 c . codret . es  .    1   . code de retour des modules                 .
 127 c .        .     .        . 0 : pas de probleme                        .
 128 c ______________________________________________________________________
 129 c
 130 c====
 131 c 0. declarations et dimensionnement
 132 c====
 133 c
 134 c 0.1. ==> generalites
 135 c
 136       implicit none
 137       save
 138 c
 139       character*6 nompro
 140       parameter ( nompro = 'DERCON' )
 141 c
 142 #include "nblang.h"
 143 c
 144 c 0.2. ==> communs
 145 c
 146 #include "envex1.h"
 147 c
 148 #include "envada.h"
 149 #include "nombar.h"
 150 #include "nombtr.h"
 151 #include "nombqu.h"
 152 #include "nombte.h"
 153 #include "nombpy.h"
 154 #include "nombpe.h"
 155 #include "nombhe.h"
 156 c
 157 c 0.3. ==> arguments
 158 c
 159       integer tyconf, homolo, maconf
 160       integer decare(0:nbarto)
 161       integer decfac(-nbquto:nbtrto)
 162       integer hetare(nbarto), filare(nbarto), merare(nbarto)
 163       integer arehom(nbarto)
 164       integer posifa(0:nbarto), facare(nbfaar)
 165       integer hettri(nbtrto), aretri(nbtrto,3)
 166       integer filtri(nbtrto), pertri(nbtrto), nivtri(nbtrto)
 167       integer homtri(nbtrto)
 168       integer voltri(2,nbtrto), pypetr(2,*)
 169       integer hetqua(nbquto), arequa(nbquto,4)
 170       integer filqua(nbquto), perqua(nbquto), nivqua(nbquto)
 171       integer quahom(nbquto)
 172       integer volqua(2,nbquto), pypequ(2,*)
 173       integer hettet(nbteto), tritet(nbtecf,4)
 174       integer hethex(nbheto), quahex(nbhecf,6), coquhe(nbhecf,6)
 175       integer hetpyr(nbpyto), facpyr(nbpycf,5), cofapy(nbpycf,5)
 176       integer hetpen(nbpeto), facpen(nbpecf,5), cofape(nbpecf,5)
 177       integer listfa(*)
 178 c
 179       integer ulsort, langue, codret
 180 c
 181 c 0.4. ==> variables locales
 182 c
 183       integer nivdeb, nivfin
 184       integer niveau
 185       integer iaux
 186 #ifdef _DEBUG_HOMARD_
 187       integer jaux, kaux
 188 #endif
 189 c
 190       integer nbmess
 191       parameter ( nbmess = 30 )
 192       character*80 texte(nblang,nbmess)
 193 c
 194 c 0.5. ==> initialisations
 195 c ______________________________________________________________________
 196 c
 197 c====
 198 c 1. initialisations
 199 c====
 200 c
 201 #include "impr01.h"
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204       write (ulsort,texte(langue,1)) 'Entree', nompro
 205       call dmflsh (iaux)
 206 #endif
 207 c
 208 #include "derco1.h"
 209 #include "impr03.h"
 210 c
 211       codret = 0
 212 #ifdef _DEBUG_HOMARD_
 213         write (ulsort,90002) 'maconf', maconf
 214         write (ulsort,90002) 'tyconf', tyconf
 215 #endif
 216 c
 217 #ifdef _DEBUG_HOMARD_
 218         do 1103 , iaux = 1 , nbarto
 219           if ( iaux.eq.-17735 .or. iaux.eq.-1207 ) then
 220             write (ulsort,90001) '.. arete e/d', iaux,
 221      >    hetare(iaux), decare(iaux)
 222           endif
 223  1103   continue
 224 #endif
 225 #ifdef _DEBUG_HOMARD_
 226         do 1104 , iaux = 1 , nbtrto
 227         if ( iaux.eq.-830 .or. iaux.eq.-800) then
 228           write (ulsort,90001) '.triangle', iaux,
 229      >    aretri(iaux,1), aretri(iaux,2),
 230      >    aretri(iaux,3)
 231           write (ulsort,90002) 'niveau et decision',
 232      >    nivtri(iaux), decfac(iaux)
 233           do 11041 ,jaux=1,3
 234           write (ulsort,90001) 'arete e/d', aretri(iaux,jaux),
 235      >    hetare(aretri(iaux,jaux)), decare(aretri(iaux,jaux))
 236 11041     continue
 237          endif
 238  1104   continue
 239         do 1105 , iaux = 1 , nbquto
 240         if ( iaux.eq.-2311 ) then
 241 cgn        if ( iaux.eq.1160 .or. iaux.eq.1411 .or.
 242 cgn     >       iaux.eq.333 .or. iaux.eq.1662.or.
 243 cgn     >       iaux.eq.1658 .or. iaux.eq.1666 .or.
 244 cgn     >       iaux.eq.729 .or. iaux.eq.721 ) then
 245           write (ulsort,90001) 'quadrangle', iaux,
 246      >    arequa(iaux,1), arequa(iaux,2),
 247      >    arequa(iaux,3), arequa(iaux,4)
 248           write (ulsort,90002) 'niveau et decision',
 249      >    nivqua(iaux), decfac(-iaux)
 250           do 11051 ,jaux=1,4
 251           write (ulsort,90001) 'arete e/d', arequa(iaux,jaux),
 252      >    hetare(arequa(iaux,jaux)), decare(arequa(iaux,jaux))
 253 11051     continue
 254          endif
 255  1105   continue
 256 #endif
 257 cgn       print *,'entree de',nompro,'perqua : ',perqua
 258 c
 259 c====
 260 c 2. algorithme : on regarde tous les niveaux dans l'ordre decroissant
 261 c
 262 c    tyconf = 1 : non-conforme avec au minimum 2 aretes non decoupees
 263 c                 .                      ---------------
 264 c                . .                     .             .
 265 c               .   .                    .             .
 266 c              .     .                   .             .
 267 c             .       .                  .             .
 268 c            .         .                 .             .
 269 c           .           .                .             .
 270 c           ------X------                --------X------
 271 c
 272 c          -------X-------               ---------------
 273 c          .             .               .             .
 274 c          .             .               .             .
 275 c          .             .               X             .
 276 c          .             .               .             .
 277 c          .             .               .             .
 278 c          .             .               .             .
 279 c          --------X------               --------X------
 280 c
 281 c    Cela correspond au raffinement libre, sans appliquer le raffinement
 282 c    de conformite final
 283 c
 284 c    tyconf = 2 : non-conforme avec 1 noeud pendant unique par arete
 285 c                 .                      ---------------
 286 c                . .                     .             .
 287 c               .   .                    .             .
 288 c              .     .                   .             .
 289 c             .       .                  .             .
 290 c            .         .                 .             .
 291 c           .           .                .             .
 292 c           ------X------                --------X------
 293 c
 294 c                 .                      ---------------
 295 c                . .                     .             .
 296 c               .   .                    .             .
 297 c              X     .                   X             .
 298 c             .       .                  .             .
 299 c            .         .                 .             .
 300 c           .           .                .             .
 301 c           ------X------                --------X------
 302 c
 303 c          -------X-------               -------X-------
 304 c          .             .               .             .
 305 c          .             .               .             .
 306 c          .             .               X             .
 307 c          .             .               .             .
 308 c          .             .               .             .
 309 c          .             .               .             .
 310 c          --------X------               --------X------
 311 c    Cela correspond a ignorer la regle des deux voisins, mais a
 312 c    appliquer la regle sur les differences de niveau
 313 c====
 314 c
 315       nivdeb = nivsup
 316       nivfin = max(nivinf-1,0)
 317       do 20 , niveau = nivdeb , nivfin , -1
 318 c
 319 #ifdef _DEBUG_HOMARD_
 320         write (ulsort,90000)
 321         write (ulsort,texte(langue,12)) niveau
 322 #endif
 323 c
 324         iaux = niveau
 325 c
 326 c 2.1. ==> cas sans entites homologues, sauf eventuellement des noeuds
 327 c
 328         if ( homolo.le.1 ) then
 329 c
 330 c 2.1.1. ==> regle des ecarts de niveau
 331 c            ==========================
 332 c
 333           if ( codret.eq.0 ) then
 334 c
 335 #ifdef _DEBUG_HOMARD_
 336             write (ulsort,texte(langue,3)) 'DERCO2', nompro
 337 #endif
 338 c
 339             call derco2 ( tyconf, iaux,
 340      >                    decare, decfac,
 341      >                    hetare, filare,
 342      >                    hettri, aretri, filtri, nivtri,
 343      >                    voltri, pypetr,
 344      >                    hetqua, arequa, filqua, nivqua,
 345      >                    volqua, pypequ,
 346      >                    tritet,
 347      >                    quahex, coquhe,
 348      >                    facpyr, cofapy,
 349      >                    facpen, cofape,
 350      >                    ulsort, langue, codret )
 351 c
 352           endif
 353 c
 354 c 2.1.2. ==> regle des deux voisins
 355 c            ======================
 356 c            elle s'applique aux cas d'adaptation :
 357 c    tyconf = 0 ; conforme
 358 c    tyconf = 1 ; non-conforme avec au minimum 2 aretes non coupees
 359 c    tyconf = -1 ; conforme avec boites
 360 c    tyconf = -2 ; non-conforme avec au maximum 1 arete coupee
 361 c
 362           if ( codret.eq.0 ) then
 363 c
 364           if ( tyconf.le.1 ) then
 365 c
 366 #ifdef _DEBUG_HOMARD_
 367             write (ulsort,texte(langue,3)) 'DERCO1', nompro
 368 #endif
 369 c
 370             call derco1 ( tyconf,
 371      >                    iaux,
 372      >                    decare, decfac,
 373      >                    hetare,
 374      >                    posifa, facare,
 375      >                    hettri, aretri, nivtri,
 376      >                    hetqua, arequa, nivqua,
 377      >                    listfa,
 378      >                    ulsort, langue, codret )
 379 #ifdef _DEBUG_HOMARD_
 380         do 2123 , iaux = 1 , nbarto
 381           if ( iaux.eq.-4739 .or. iaux.eq.-1207 ) then
 382             write (ulsort,90001) '.. arete e/d', iaux,
 383      >      hetare(iaux), decare(iaux)
 384           endif
 385  2123   continue
 386         do 2125 , jaux = 1 , nbquto
 387         if ( jaux.eq.-215996 .or. jaux.eq.-66980 ) then
 388           write (ulsort,90001) 'quadrangle', jaux,
 389      >    arequa(jaux,1), arequa(jaux,2),
 390      >    arequa(jaux,3), arequa(jaux,4)
 391           write (ulsort,90002) 'de decision', decfac(-jaux)
 392          endif
 393  2125   continue
 394 #endif
 395 c
 396           endif
 397 c
 398           endif
 399 c
 400 c 2.1.3. ==> ecarts de niveau, complements non conforme, 1 noeud pendant
 401 c            ===========================================================
 402 c
 403           if ( tyconf.eq.2 ) then
 404 c
 405             if ( niveau.gt.1 ) then
 406 c
 407               if ( codret.eq.0 ) then
 408 c
 409 #ifdef _DEBUG_HOMARD_
 410               write (ulsort,texte(langue,3)) 'DERCO3', nompro
 411 #endif
 412 c
 413               call derco3 ( iaux,
 414      >                      decare, decfac,
 415      >                      merare,
 416      >                      posifa, facare,
 417      >                      hettri, aretri, pertri, nivtri,
 418      >                      voltri,
 419      >                      hetqua, arequa, perqua, nivqua,
 420      >                      tritet,
 421      >                      ulsort, langue, codret )
 422 #ifdef _DEBUG_HOMARD_
 423         do 2135 , jaux = 1 , nbquto
 424         if ( jaux.eq.-94774 ) then
 425           write (ulsort,90001) 'quadrangle', jaux,
 426      >    arequa(jaux,1), arequa(jaux,2),
 427      >    arequa(jaux,3), arequa(jaux,4)
 428           write (ulsort,90002) 'de decision', decfac(-jaux)
 429          endif
 430  2135   continue
 431 #endif
 432 c
 433               endif
 434 c
 435             endif
 436 c
 437 c=======================================================================
 438             if ( nbteto.gt.0 .or. nbheto.gt.0 .or. nbpeto.gt.0 ) then
 439 c
 440               if ( codret.eq.0 ) then
 441 c
 442 c   ATTENTION : c'est une verrue pour imposer un rapport 1/4 sur
 443 c                les recollements de non conformite
 444 c                 a filtrer quand on aura ameliore le pilotage
 445 c                      du non conforme
 446 #ifdef _DEBUG_HOMARD_
 447               write (ulsort,texte(langue,3)) 'DERCO8', nompro
 448 #endif
 449 c
 450               call derco8 ( iaux,
 451      >                      decare, decfac,
 452      >                      hetare,
 453      >                      hettri, aretri, pertri, nivtri,
 454      >                      voltri,
 455      >                      hetqua, arequa, perqua, nivqua,
 456      >                      volqua,
 457      >                      hettet, tritet,
 458      >                      hethex, quahex,
 459      >                      ulsort, langue, codret )
 460 #ifdef _DEBUG_HOMARD_
 461         do 21351 , jaux = 1 , nbquto
 462         if ( jaux.eq.-94774 ) then
 463           write (ulsort,90001) 'quadrangle', jaux,
 464      >    arequa(jaux,1), arequa(jaux,2),
 465      >    arequa(jaux,3), arequa(jaux,4)
 466           write (ulsort,90002) 'de decision', decfac(-jaux)
 467          endif
 468 21351   continue
 469 #endif
 470 c
 471               endif
 472 c
 473             endif
 474 c=======================================================================
 475 c
 476             if ( codret.eq.0 ) then
 477 c
 478 #ifdef _DEBUG_HOMARD_
 479             write (ulsort,texte(langue,3)) 'DERCO7', nompro
 480 #endif
 481 c
 482             call derco7 ( iaux,
 483      >                    decare, decfac,
 484      >                    hetare,
 485      >                    hettri, aretri, nivtri,
 486      >                    voltri,
 487      >                    hetqua, arequa, nivqua,
 488      >                    volqua,
 489      >                    ulsort, langue, codret )
 490 c
 491 #ifdef _DEBUG_HOMARD_
 492         do 21353 , iaux = 1 , nbarto
 493           if ( iaux.eq.-4739 .or. iaux.eq.-1207 ) then
 494             write (ulsort,90001) '.. arete e/d', iaux,
 495      >      hetare(iaux), decare(iaux)
 496           endif
 497 21353   continue
 498         do 21352 , jaux = 1 , nbquto
 499         if ( jaux.eq.-94774 ) then
 500           write (ulsort,90001) 'quadrangle', jaux,
 501      >    arequa(jaux,1), arequa(jaux,2),
 502      >    arequa(jaux,3), arequa(jaux,4)
 503           write (ulsort,90002) 'de decision', decfac(-jaux)
 504          endif
 505 21352   continue
 506 #endif
 507             endif
 508 c
 509           endif
 510 c
 511 c 2.2. ==> cas avec homologues
 512 c
 513         else
 514 c
 515 c 2.2.1. ==> regle des ecarts de niveau
 516 c            ==========================
 517 c
 518           if ( codret.eq.0 ) then
 519 c
 520 c          if ( niveau.gt.0 ) then
 521 c
 522 #ifdef _DEBUG_HOMARD_
 523             write (ulsort,texte(langue,3)) 'DERCO5', nompro
 524 #endif
 525 c
 526             call derco5 ( tyconf, iaux,
 527      >                    decare, decfac,
 528      >                    hetare, filare, arehom,
 529      >                    hettri, aretri, filtri, nivtri, homtri,
 530      >                    voltri, pypetr,
 531      >                    hetqua, arequa, filqua, nivqua, quahom,
 532      >                    volqua, pypequ,
 533      >                    tritet,
 534      >                    quahex, coquhe,
 535      >                    facpyr, cofapy,
 536      >                    facpen, cofape,
 537      >                    ulsort, langue, codret )
 538 c
 539 c          endif
 540 c
 541           endif
 542 c
 543 c 2.2.2. ==> regle des deux voisins
 544 c            ======================
 545 c            elle s'applique aux cas de raffinement :
 546 c    tyconf = 0 ; libre
 547 c    tyconf = 1 ; non-conforme avec au miximum 2 aretes non coupees
 548 c    tyconf = -1 ; libre avec boites
 549 c    tyconf = -2 ; non-conforme avec au maximum 1 arete coupee
 550 c
 551           if ( codret.eq.0 ) then
 552 c
 553           if ( tyconf.le.1 ) then
 554 c
 555 #ifdef _DEBUG_HOMARD_
 556             write (ulsort,texte(langue,3)) 'DERCO4', nompro
 557 #endif
 558 c
 559             call derco4 ( tyconf,
 560      >                    iaux,
 561      >                    decare, decfac,
 562      >                    hetare, arehom,
 563      >                    posifa, facare,
 564      >                    hettri, aretri, nivtri,
 565      >                    hetqua, arequa, nivqua,
 566      >                    listfa,
 567      >                    ulsort, langue, codret )
 568 c
 569           endif
 570 c
 571           endif
 572 c
 573 c 2.2.3. ==> ecarts de niveau, complements non conforme, 1 noeud pendant
 574 c            ===========================================================
 575 c
 576           if ( tyconf.eq.2 ) then
 577 c
 578             if ( niveau.gt.1 ) then
 579 c
 580               if ( codret.eq.0 ) then
 581 c
 582 #ifdef _DEBUG_HOMARD_
 583               write (ulsort,texte(langue,3)) 'DERCO6', nompro
 584 #endif
 585 c
 586               call derco6 ( iaux,
 587      >                      decare, decfac,
 588      >                      merare, arehom,
 589      >                      posifa, facare,
 590      >                      hettri, aretri, pertri, nivtri,
 591      >                      voltri,
 592      >                      hetqua, arequa, perqua, nivqua,
 593      >                      tritet,
 594      >                      listfa,
 595      >                      ulsort, langue, codret )
 596 c
 597               endif
 598 c
 599             endif
 600 c
 601             if ( codret.eq.0 ) then
 602 c
 603 #ifdef _DEBUG_HOMARD_
 604             write (ulsort,texte(langue,3)) 'DERCO7', nompro
 605 #endif
 606 c
 607             call derco7 ( iaux,
 608      >                    decare, decfac,
 609      >                    hetare,
 610      >                    hettri, aretri, nivtri,
 611      >                    voltri,
 612      >                    hetqua, arequa, nivqua,
 613      >                    volqua,
 614      >                    ulsort, langue, codret )
 615 c
 616             endif
 617 c
 618           endif
 619 c
 620         endif
 621 cgn        print *,'fin 20, n = ',niveau,', ',decfac(5), decfac(8)
 622 c
 623    20 continue
 624 c
 625 #ifdef _DEBUG_HOMARD_
 626       write (ulsort,texte(langue,1)) 'Sortie', nompro
 627         do 2103 , iaux = 1 , nbarto
 628           if ( iaux.eq.-17735 .or. iaux.eq.-1207 ) then
 629             write (ulsort,90001) '.. arete e/d', iaux,
 630      >    hetare(iaux), decare(iaux)
 631           endif
 632  2103   continue
 633         do 2104 , iaux = 1 , nbtrto
 634         if ( iaux.eq.-830 .or. iaux.eq.-833 .or. iaux.eq.-800) then
 635           write (ulsort,90001) '.triangle', iaux,
 636      >    aretri(iaux,1), aretri(iaux,2),
 637      >    aretri(iaux,3)
 638           write (ulsort,90002) '.. niveau et decision',
 639      >    nivtri(iaux), decfac(iaux)
 640           do 21041 ,jaux=1,3
 641           write (ulsort,90001) '.. arete e/d', aretri(iaux,jaux),
 642      >    hetare(aretri(iaux,jaux)), decare(aretri(iaux,jaux))
 643 21041     continue
 644           endif
 645  2104   continue
 646         do 2105 , iaux = 1 , nbquto
 647         if ( iaux.eq.-2311 ) then
 648 cgn        if ( iaux.eq.1160 .or. iaux.eq.1411 .or.
 649 cgn     >       iaux.eq.333 .or. iaux.eq.1662 .or.
 650 cgn     >       iaux.eq.1658 .or. iaux.eq.1666 .or.
 651 cgn     >       iaux.eq.729 .or. iaux.eq.721 ) then
 652           write (ulsort,90001) 'quadrangle', iaux,
 653      >    arequa(iaux,1), arequa(iaux,2),
 654      >    arequa(iaux,3), arequa(iaux,4)
 655           write (ulsort,90002) 'de decision', decfac(-iaux)
 656           do 21051 ,jaux=1,4
 657           write (ulsort,90001) 'arete e/d', arequa(iaux,jaux),
 658      >    hetare(arequa(iaux,jaux)), decare(arequa(iaux,jaux))
 659 21051     continue
 660          endif
 661  2105   continue
 662 #endif
 663 c
 664 c====
 665 c 3. la fin
 666 c====
 667 c
 668       if ( codret.ne.0 ) then
 669 c
 670 #include "envex2.h"
 671 c
 672       write (ulsort,texte(langue,1)) 'Sortie', nompro
 673       write (ulsort,texte(langue,2)) codret
 674 c
 675       endif
 676 c
 677 #ifdef _DEBUG_HOMARD_
 678       write (ulsort,texte(langue,1)) 'Sortie', nompro
 679       call dmflsh (iaux)
 680 #endif
 681 c
 682       end