C EXTR14    SOURCE    PV        09/03/12    21:22:06     6325           
      SUBROUTINE EXTR14(IPCHE1,IENT1,IENT2,IENT3,MOT)
*_____________________________________________________________________
*
*     Extrait une composante d'un MCHAML
*
*  Entrees :
*  ---------
*
*     IPCHE1  Pointeur sur un MCHAML
*     IENT1   Numero de la sous zone
*     IENT2   Numero de l'element
*     IENT3   Numero du point de gauss
*     MOT     Nom de la composante a extraire ou mot cle indiquant
*             l'action a effectuer  (TITR = TYPE ou MAIL)
*
*  JM CAMPENON le 07/91
*  C La Borderie le 21/07/92 :possibilite d'extraire une composante entiere
*  PP 21/12/92 :extension a l'extraction d'un objet de type quelconque
*_____________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC CCOPTIO
-INC SMCHAML
-INC SMINTE
-INC SMLMOTS
-INC SMELEME
*
      logical ltelq
      REAL*8 FLOX
      CHARACTER*4 MOT
      CHARACTER*8 TYPOBJ
      CHARACTER*72 CTEXT
*
      MCHELM=IPCHE1
      SEGACT MCHELM
      NSOUS=ICHAML(/1)
*
      IF ((MOT.EQ.'TITR').OR.(MOT.EQ.'TYPE')) THEN
         JGM=1
         JGN=TITCHE(/1)
         CTEXT=TITCHE
         SEGDES MCHELM
         SEGINI MLMOTS
         IPMOTS=MLMOTS
         MOTS(1)=CTEXT
         SEGDES MLMOTS
         CALL ECROBJ('LISTMOTS',IPMOTS)
         RETURN
      ELSE IF (MOT.EQ.'MAIL') THEN
         IPP1=IMACHE(1)
         IF(NSOUS.GT.1) THEN
            DO 30 I=2,NSOUS
               IPP2=IMACHE(I)
               ltelq=.false.
               CALL FUSE (IPP1,IPP2,IRET,ltelq)
               IPP1=IRET
 30        CONTINUE
         ENDIF
         CALL ECROBJ('MAILLAGE',IPP1)
         GOTO 555
      ENDIF
*
      IF (IENT1.GT.NSOUS) THEN
*
*        Sous zone inexistante
*
         CALL ERREUR(279)
         GOTO 555
      ENDIF
*
      MELEME=IMACHE(IENT1)
      SEGACT MELEME
      NBELEM=NUM(/2)
      NBPGAU=NUM(/1)
      SEGDES MELEME
*
      N3=INFCHE(/2)
      IF (N3.GE.4) THEN
         MINTE=INFCHE(IENT1,4)
         IF(MINTE.NE.0)THEN
          SEGACT MINTE
          NBPGAU=POIGAU(/1)
          SEGDES MINTE
        ENDIF
      ENDIF
*
      IF (IENT3.GT.NBPGAU.OR.IENT2.GT.NBELEM) THEN
*
*        Numero du point de gauss ou de l'element trop grand
*
         CALL ERREUR(281)
         GOTO 555
      ENDIF
*
      MCHAML=ICHAML(IENT1)
      SEGACT MCHAML
      NCOMP=IELVAL(/1)
      DO 100 ICOMP=1,NCOMP
         IF (MOT.EQ.NOMCHE(ICOMP)) GOTO 200
 100  CONTINUE
*
*     Composante inexistante
*
      CALL ERREUR (280)
      GOTO 444
*
 200  CONTINUE
      MELVAL=IELVAL(ICOMP)
      SEGACT MELVAL
C+PP
      IF(TYPCHE(ICOMP)(1:6).EQ.'REAL*8')THEN
         IGMN=MIN(IENT3,VELCHE(/1))
         IBMN=MIN(IENT2,VELCHE(/2))
         FLOX=VELCHE(IGMN,IBMN)
         CALL ECRREE(FLOX)
      ELSE
        TYPOBJ=TYPCHE(ICOMP)(9:16)
        IGMN=MIN(IENT3,IELCHE(/1))
        IBMN=MIN(IENT2,IELCHE(/2))
        IPOOBJ=IELCHE(IGMN,IBMN)
        CALL ECROBJ(TYPOBJ,IPOOBJ)
      ENDIF
C+PP
      SEGDES MELVAL
*
 444  CONTINUE
      SEGDES MCHAML
*
 555  CONTINUE
      SEGDES MCHELM
      RETURN
      END