C KQCEST    SOURCE    CB215821  19/08/20    21:18:56     10287          
      SUBROUTINE KQCEST(MAIL,IKR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C     Ce SP regarde la famille d'éléments
C
C     IKT = 0 Ce n'était pas des QCF
C     IKT = 1 C'était des QCF
C     IKL = 0 Ce n'était pas des Lineaires
C     IKL = 1 C'était des Lineaires
C     IKR = 0 Famille non reconnue
C     IKR = 1 C'était des QCF
C     IKR = 2 C'était des Lineaires
C     IKR = 3 C'était des Macro
C     IKR = 4 C'était des quadratiques castem 2000 (mecanique)
C     IKR =34 C'était des Macro ou des Quad
C     IKR =134 C'était des Macro ou des Quad ou des quaf
C     IKR =1341 C'était des Macro ou des Quad ou des quaf  SEG3
C     IKR =13  C'était des Macro ou des Quaf
C
C*************************************************************************

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC CCGEOME
-INC SMELEME
      PARAMETER (NBTE=28)
      CHARACTER*8 NOM8,LTYPL(NBTE)

      DATA LTYPL/
     &  'SEG3    ','TRI7    ','QUA9    ',
     &  'CU27    ','PR21    ','TE15    ','PY19    ',
     &  'SEG2    ','TRI3    ','QUA4    ',
     &  'CUB8    ','PRI6    ','TET4    ','PYR5    ',
     &  'SEG3    ','TRI6    ','QUA9    ',
     &  'CU27    ','PR18    ','TE10    ','PY14    ',
     &  'SEG3    ','TRI6    ','QUA8    ',
     &  'CU20    ','PR15    ','TE10    ','PY13    '/



C****
      MELEME=MAIL
      IKR=0
      SEGACT MELEME
      NBSOUS=LISOUS(/1)
C On regarde à qui on a à faire
C     SONT ce des QCF IKT=1  ?
      IKKT=1
      IKKL=1
      IKKM=1
      IKKQ=1
      NBSOU1=NBSOUS
      IF(NBSOU1.EQ.0)NBSOU1=1
      DO 1670 L=1,NBSOU1
      IPT1=MELEME
      IF(NBSOU1.NE.1)IPT1=LISOUS(L)
      SEGACT IPT1
      NOM8=NOMS(IPT1.ITYPEL)//'    '
      CALL OPTLI(IP,LTYPL,NOM8,NBTE)
      IF(IP.EQ.0)THEN
      IKR=0
      RETURN
      ENDIF
      IF(NOM8.EQ.'SEG3'.AND.NBSOU1.EQ.1)THEN
      IKR =1341
      RETURN
      ENDIF
      IF(IP.GT.7)IKKT=0
      CALL OPTLI(IP,LTYPL(8),NOM8,7)
      IF(IP.EQ.0)IKKL=0
      CALL OPTLI(IP,LTYPL(15),NOM8,7)
      IF(IP.EQ.0)IKKM=0
      CALL OPTLI(IP,LTYPL(22),NOM8,7)
      IF(IP.EQ.0)IKKQ=0
 1670 CONTINUE

C     write(6,*)'IKKT,IKKL,IKKM,IKKQ=',IKKT,IKKL,IKKM,IKKQ
      IF(IKKT.NE.0)IKR=1
      IF(IKKL.NE.0)IKR=2
      IF(IKKM.NE.0)IKR=3
      IF(IKKQ.NE.0)IKR=4
      IF(IKKM.EQ.1.AND.IKKQ.EQ.1)IKR=34
      IF(IKKT.EQ.1.AND.IKKM.EQ.1.AND.IKKQ.EQ.1)IKR=134
      IF(IKKT.EQ.1.AND.IKKM.EQ.1)IKR=13

 1001 FORMAT(20(1X,I5))
      END