subroutine utsuar ( disare,
     >                    hetare, merare, filare,
     >                    ancare, nouare,
     >                    nbarre )
c ______________________________________________________________________
c
c                             H O M A R D
c
c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
c
c Version originale enregistree le 18 juin 1996 sous le numero 96036
c aupres des huissiers de justice Simart et Lavoir a Clamart
c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
c aupres des huissiers de justice
c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
c
c    HOMARD est une marque deposee d'Electricite de France
c
c Copyright EDF 1996
c Copyright EDF 1998
c Copyright EDF 2002
c Copyright EDF 2020
c ______________________________________________________________________
c
c    UTilitaire - SUppression des ARetes
c    --           --              --
c ______________________________________________________________________
c
c   Attention : toutes les aretes n'ont pas forcement une mere !
c               celles crees en interne a des tetraedres/triangles
c               sont de la premiere generation, meme si elles
c               sont a des niveaux > 1
c ______________________________________________________________________
c .        .     .        .                                            .
c .  nom   . e/s . taille .           description                      .
c .____________________________________________________________________.
c . disare . e   . nouvar . indicateurs de disparition des aretes      .
c . hetare . es  . nouvar . historique de l'etat des aretes            .
c . merare . es  . nouvar . mere des aretes                            .
c . filare . es  . nouvar . premiere fille des aretes                  .
c . ancare .   s . nouvar . anciens numeros des aretes conservees      .
c . nouare .   s .0:nouvar. nouveaux numeros des aretes conservees     .
c . nbarre .   s .   1    . nombre d'aretes restantes                  .
c ______________________________________________________________________
c
c====
c 0. declarations et dimensionnement
c====
c
c 0.1. ==> generalites
c
      implicit none
      save
c
cgn      character*6 nompro
cgn      parameter ( nompro = 'UTSUAR' )
c
c 0.2. ==> communs
c
#include "nombar.h"
#include "nouvnb.h"
c
c 0.3. ==> arguments
c
      integer hetare(nouvar), merare(nouvar), filare(nouvar)
      integer disare(nouvar), ancare(nouvar)
      integer nouare(0:nouvar)
      integer nbarre
c
c 0.4. ==> variables locales
c
      integer larete, lamere, gdmere, etgmer
      integer cmptr, e1, e2, et
c ______________________________________________________________________
c
c====
c 1. fabrication des tableaux ancare et nouare
c====
c
      cmptr = 0
      nouare(0) = 0
c
c 1.1 generation des tableaux reciproques
c
      do 100 , larete = 1 , nbarpe
c
        if ( disare(larete).ne.0 ) then
c
          nouare(larete) = 0
          hetare(larete) = 10 * int( hetare(larete) / 10 ) + 5
c
        else
c
          cmptr = cmptr + 1
          ancare(cmptr)  = larete
          nouare(larete) = cmptr
c
        endif
c
  100 continue
c
c 1.2 nombre d'entites restantes apres suppression
c     (pour la remise a jour du nombre d'entites du maillage)
c
      nbarre = cmptr
c
c====
c 2. modification des etats des meres eventuelles des aretes disparues
c====
c
      do 200 , larete = 1 , nbarpe
c
        if ( disare(larete).ne.0 ) then
c
c         mise a zero de l'etat actuel de la mere
c
          lamere = merare(larete)
c
          if ( lamere.ne.0 ) then
            hetare(lamere) = hetare(lamere) - mod(hetare(lamere),10)
          endif
c
        endif
c
  200 continue
c
c====
c 3. modification des etats des eventuelles grand-meres des aretes
c====
c
      do 300 , larete = 1 , nbarpe
c
        if ( disare(larete).ne.0 ) then
c
          lamere = merare(larete)
c
          if ( lamere.ne.0 ) then
c
            gdmere = merare(lamere)
c
            if ( gdmere.ne.0 ) then
c
c 3.1     verification de l'etat de la grand-mere
c
              etgmer = mod( hetare(gdmere) , 10 )
c
              if ( etgmer.ne.2 ) then
c
c 3.1.1     verification de l'etat des soeurs de la mere
c
                e1 = mod( hetare(filare(gdmere))   , 10 )
                e2 = mod( hetare(filare(gdmere)+1) , 10 )
                et = e1 + e2
c
c 3.1.2       attribution de l'etat 'coupee en 2' a l'entite
c
                if ( et .eq. 0 ) then
                  hetare(gdmere) = hetare(gdmere)
     >                           - mod(hetare(gdmere),10)
     >                           + 2
                endif
c
              endif
c
            endif
c
          endif
c
        endif
c
  300 continue
c
      end