C GENMCT    SOURCE    CHAT      05/01/13    00:17:25     5004
      SUBROUTINE GENMCT(MCTP0,MCTD0,MCT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMELEME
      POINTEUR MCTP.MELEME,MCTD.MELEME,MCT.MELEME
      POINTEUR MCTP0.MELEME,MCTD0.MELEME


      SEGACT MCTP0,MCTD0
      NBSOUP=MCTP0.LISOUS(/1)
      NBSOUD=MCTD0.LISOUS(/1)
      IF(NBSOUP.EQ.0)NBSOUP=1
      IF(NBSOUD.EQ.0)NBSOUD=1

      NBSOUS=0
      NBREF=0
      NBNN=0
      NBELEM=0
      SEGINI MELEME
C     write(6,*)' MELEME=',MELEME

      IX1=0
      IX2=0

      NBSOU0=0
      DO 40 L=1,NBSOUP
      IPT1=MCTP0
      IF(NBSOUP.NE.1)IPT1=MCTP0.LISOUS(L)
      SEGACT IPT1
      NP1=IPT1.NUM(/1)
      NBEL1=IPT1.NUM(/2)
      IF(IX1.EQ.0)THEN
      N1D=1
      N1A=NBEL1
      LG1=NBEL1
      K1=0
      ENDIF

      DO 50 M=1,NBSOUD
      IPT2=MCTD0
      IF(NBSOUD.NE.1)IPT1=MCTD0.LISOUS(M)
      SEGACT IPT2
      NP2=IPT2.NUM(/1)
      NBEL2=IPT2.NUM(/2)
      IF(IX2.EQ.0)THEN
      N2D=1
      N2A=NBEL2
      LG2=NBEL2
      K2=0
      ENDIF

      NBELEM=0
      NBNN=0
      NBREF=0
      NBSOU0=NBSOU0+1
      NBSOUS=NBSOU0

C     write(6,*)' NBSOUS=',nbsous
      SEGADJ MELEME

      NBELEM=MIN(LG1,LG2)
      NBNN=NP1+NP2
      NBREF=0
      NBSOUS=0
      SEGINI IPT3
      LISOUS(NBSOU0)=IPT3
      IPT3.ITYPEL=28
C     write(6,*)' NBELEM,NBNN,NP1,NP2,K1,K2=',
C    & NBELEM,NBNN,NP1,NP2,K1,K2
      DO 61 K=1,NBELEM
      K1=K1+1
      K2=K2+1
      DO 62 I=1,NP1
      IPT3.NUM(I,K)=IPT1.NUM(I,K1)
 62   CONTINUE
      DO 63 I=1,NP2
      IPT3.NUM(I+NP1,K)=IPT2.NUM(I,K2)
 63   CONTINUE
 61   CONTINUE

      IF(K1.EQ.NBEL1)THEN
      IX2=1
      GO TO 40
      ELSEIF(K2.EQ.NBEL2)THEN
      IX1=1
      GO TO 50
      ENDIF

 50   CONTINUE
 40   CONTINUE


      IF(NBSOU0.EQ.1)THEN
      SEGSUP MELEME
      MELEME=IPT3
      ENDIF
      MCT=MELEME
      RETURN
      END