C MSOMET    SOURCE    CB215821  26/08/24    21:17:22     12622          
      SUBROUTINE MSOMET(MELEME,MELEMM,MELEMS,TYPE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

      CHARACTER*8 TYPE
      PARAMETER (NBTYP=7)
      DIMENSION LISTN(4,NBTYP),ITAB(8,7)

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
      POINTEUR MELEMM.MELEME
      DATA LISTN/
C     seg3      qua9       tri7
     &3,2,3,2,  11,8,8,4,  7,4,6,3,
C     seg2      qua4       tri3
C     cu27        pr21        te15        py19
     &33,14,20,8, 34,16,18,6, 35,23,10,4, 36,25,13,5/
C     cub8        pri6        tet4        pyr5
      DATA ITAB/
     & 1,3,6*0,  1,3,5,7,4*0,  1,3,5,5*0,
     & 1,3,5,7,13,15,17,19,  1,3,5,10,12,14,2*0,
     & 1,3,5,10,4*0,  1,3,5,7,13,3*0 /

      TYPE=' '
      SEGACT MELEME
      NBSOUS=MAX(1,LISOUS(/1))
      NBREF=0
      NBELEM=0
      NBNN=0
      SEGINI MELEMM

      DO 1 L=1,MAX(1,LISOUS(/1))
      IPT1=MELEME
      IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
      SEGACT IPT1
      DO 2 M=1,NBTYP
C     write(6,*)' MSOMET : IPT1.ITYPEL=',IPT1.ITYPEL
      IF(IPT1.ITYPEL.EQ.LISTN(1,M))GO TO 21
 2    CONTINUE
C     write(6,*)' MSOMET :echec 1 '
      RETURN
 21   CONTINUE
      NBSOUS=0
      NBELEM=IPT1.NUM(/2)
      NBNN=LISTN(4,M)
      SEGINI IPT2
      IPT2.ITYPEL=LISTN(2,M)
      MELEMM.LISOUS(L)=IPT2
      NP=LISTN(3,M)
C     write(6,*)'NBNN NBELEM=',NBNN,NBELEM,' M=',M



      IF(M.LE.7)THEN
      DO 102 K=1,NBELEM
      DO 101 I=1,NBNN
      I1=ITAB(I,M)
      IPT2.NUM(I,K)=IPT1.NUM(I1,K)
 101  CONTINUE
  102 CONTINUE

      ELSE
      RETURN
      ENDIF
 1    CONTINUE
      IPT3=MELEMM
      IF(MELEMM.LISOUS(/1).EQ.1)THEN
      MELEMM=MELEMM.LISOUS(1)
      SEGSUP IPT3
      ENDIF
      MELEMS=MELEMM
      ITY=1
      CALL CHANGE(MELEMS,ITY)
      IF (IERR.NE.0) RETURN
      TYPE='MAILLAGE'

      RETURN
      END