C CATMEL    SOURCE    CHAT      05/01/12    21:49:37     5004
      SUBROUTINE CATMEL(IPT1,IPT2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*****************************************************************************
C
C CE SOUS PROGRAMME CONCATENE L 'OBJET MAILLAGE IPT2 A L'OBJET MAILLAGE
C IPT1 SANS FUSIONNER SUR LES TYPES D ELEMENT
C SI IPT1=0 ON CREE L 'OBJET IPT1, ON NE RENVOIE PAS IPT1=IPT2
C
C*****************************************************************************
-INC SMELEME

      SEGACT IPT2
      NBS2=IPT2.LISOUS(/1)

      IF(IPT1.EQ.0)THEN
C CAS OU ON CREE IPT1

       IF(NBS2.EQ.0)THEN
        NBNN=IPT2.NUM(/1)
        NBELEM=IPT2.NUM(/2)
        NBREF=0
        NBSOUS=0
        SEGINI MELEME
        CALL RSETI(NUM,IPT2.NUM,NBNN*NBELEM)
        ITYPEL=IPT2.ITYPEL
        SEGDES MELEME
        IPT1=MELEME
        SEGDES IPT2
        RETURN
       ELSE
        NBNN=0
        NBELEM=0
        NBSOUS=NBS2
        NBREF=0
        SEGINI MELEME
        CALL RSETI(LISOUS,IPT2.LISOUS,NBSOUS)
        SEGDES MELEME
        IPT1=MELEME
        SEGDES IPT2
        RETURN
       ENDIF

      ELSE
C CAS OU IPT1 EXISTE

      SEGACT IPT1
      NBS1=IPT1.LISOUS(/1)
       IF(NBS1.EQ.0)THEN
       NBNN=0
       NBELEM=0
         IF(NBS2.EQ.0)THEN
          NBSOUS=2
         ELSE
          NBSOUS=1+NBS2
         ENDIF
       NBREF=0
       SEGINI MELEME
        LISOUS(1)=IPT1
         IF(NBS2.EQ.0)THEN
          LISOUS(2)=IPT2
         ELSE
          CALL RSETI(LISOUS(2),IPT2.LISOUS,NBS2)
         ENDIF
        SEGDES IPT1
        IPT1=MELEME
        SEGDES IPT1
        SEGDES IPT2
        RETURN

       ELSE
        NBNN=0
        NBELEM=0
        NBREF=0
         IF(NBS2.EQ.0)THEN
          NBSOUS=NBS1+1
          MELEME=IPT1
          SEGADJ MELEME
          NL=LISOUS(/1)
          LISOUS(NL)=IPT2
          SEGDES MELEME,IPT2
          IPT1=MELEME
          RETURN
         ELSE
          NBSOUS=NBS1+NBS2
          MELEME=IPT1
          SEGADJ MELEME
          CALL RSETI(LISOUS(NBS1+1),IPT2.LISOUS,NBS2)
          SEGDES MELEME,IPT2
          RETURN
         ENDIF
       ENDIF
      ENDIF

      END