C AJOUEL    SOURCE    CB215821  17/07/25    21:15:03     9519           
C
      SUBROUTINE AJOUEL(NODE,NBNODE,ityp1,IMELE,IEL)
C--------------------------------------------------------------
C
C FONCTION :
C     Verifie l'existence d'un element (defini par ses noeuds)
C     en tenant compte de l'eventuelle permutation des noeuds
C     et Ajoute cet element au maillage si non existence
C
C NODE  : ENTREE  : Tableau des noeudsde dimension NBNODE
C ityp1 : ENTREE  : ITYPEL (type d'element)
C IMELE : E/S   :  Pointeur vers MELEME (actif et modifiable en E/S)
C IEL : ENTREE  :  Numero de l element qu'on propose de créer
C IEL : SORTIE  :  Numero de l element effectivement créé ou retrouvé
C
C APPELE PAR : INTGEO
C
C CREATION : BP 2012/09/11
C
C--------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      INTEGER NODE(NBNODE)
      SEGMENT IVU(NBNODE)
C

-INC PPARAM
-INC CCOPTIO
-INC SMELEME

c       write(ioimp,fmt="('ajouel(',I5,I5,I3,I3,I7,I3)")
c      &NODE(1),NODE(2),NBNODE,ityp1,IMELE,IEL

C--------------------------------------------------------------
C     PRELIMINAIRES et initialisation

      SEGINI,IVU
c     on commence par le 1er noeud a cherche
      inode=1
      nono = NODE(inode)

C--------------------------------------------------------------
C     ON RECHERCHE LE POINT (idem ELIM)

c     maillage a verifier (actif et modifiable en entrée)
      IPT1   = IMELE
c     segact,IPT1

      NBSOUS = IPT1.LISOUS(/1)
c     dans le cas d un meleme complexe,
c==== il faut boucler sur les differents type d elements ====
      DO 100 ISOUS=1,max(1,NBSOUS)

        if (NBSOUS.ne.0)  then
          MELEME=IPT1.LISOUS(isous)
c           segact,meleme
        else
          MELEME=IPT1
        endif

        if(ITYPEL.ne.ityp1) goto 100
        NBNN = NUM(/1)
        NBEL = NUM(/2)
C ici MELEME est un maillage simple (NSOUS = 0)
        NBSOUS = LISOUS(/1)
        NBREF  = LISREF(/1)
c         write(ioimp,*) 'ajouel: on a trouvé le bon itypel=',ityp1
c      &  ,' associe au maillage de dim=',NBNN,NBEL

        if(NBNN.ne.NBNODE) then
c         goto 100
c         write(ioimp,*)'ajouel: ITYPEL et nombre de noeuds incompatibles'
          call erreur(21)
        endif
c       on a le bon nombre de noeuds :
c       on cherche si l element fourni existe deja

c         write(ioimp,*)'ajouel: on cherche le ',inode,'ieme noeud=',nono


c       boucle sur les element du maillage
        DO 71 J=1,NBEL

c         on remet a zero si IVU a bougé
          if(inode.gt.1) then
            do iii=1,(inode-1)
              IVU(iii)=0
            enddo
c           on commence par le 1er noeud
            inode=1
            nono = NODE(inode)
          endif

c         boucle sur les noeuds
 72       I=0
 73       I=I+1
            ii=NUM(I,J)
c             write(ioimp,*) 'on teste ',ii,' =element NUM(',I,J,')'
            IF(ii.eq.0) GOTO 71
c           on a trouvé nono !
            IF(ii.eq.nono) THEN
c               write(ioimp,*) 'on a trouvé ',ii,' element NUM(',I,J,')'
              IVU(inode)=I
              if(inode.eq.NBNODE) goto 700
c             si on n a pas fini on continue dans cet element
              inode = inode +1
              nono = NODE(inode)
              goto 72
            ENDIF
c           si on a fini de boucler sur les noeuds => element suivant
            if(I.eq.NBNN) goto 71
            goto 73

 71     CONTINUE


C--------------------------------------------------------------
c       si élément non trouvé on le crée à la IEL ieme place
        if(NBEL.lt.IEL) then
          NBELEM=IEL
C ici MELEME est un maillage simple (NSOUS = 0)
          NBSOUS = LISOUS(/1)
          NBREF  = LISREF(/1)
          segadj,MELEME
        endif
        if(NUM(1,IEL).ne.0) then
          write(ioimp,*) 'ajouel : on écrase un élément existant !'
        endif
        do inode=1,NBNODE
          NUM(inode,IEL)=NODE(inode)
        enddo
        SEGSUP,IVU
        RETURN

C--------------------------------------------------------------
c       on a trouvé l element deja existant
 700    CONTINUE
        IEL = J
c         write(ioimp,*) 'on a trouvé l element deja existant ',IEL


 100  CONTINUE
c==== fin de boucle sur les differents type d elements ====
      
      SEGSUP,IVU
      RETURN

      END