C EXTR23    SOURCE    JC220346  12/12/13    21:15:03     7610           
************************************************************************
* NOM         : extr23
* DESCRIPTION : Extrait les valeurs d'un CHPOINT a une composante pour
*               les mettre dans un LISTREEL
************************************************************************
* HISTORIQUE :  12/12/2012 : JCARDO : création de la subroutine
* HISTORIQUE :  13/12/2012 : JCARDO : nouvel argument MLMOTS contenant
*                                     la liste des composantes à sortir
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
* APPELÉ PAR : extrai.eso
************************************************************************
* ENTRÉES :: aucune
* SORTIES :: aucune
************************************************************************
* SYNTAXE (GIBIANE) :
*
*          LREEL1 = EXTR 'VALE' (MOT1 | LMOT1) CHPO1 (MAIL1) ;
*
************************************************************************
      SUBROUTINE EXTR23(ICHPOI,MLMOTS,MELEME,MLREEL)
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMLREEL
-INC SMLMOTS
*
      CHARACTER*4 MCO
*
*
*     Création de la liste de réels renvoyée en sortie
      JG=0
      SEGINI,MLREEL
*
************************************************************************
*   G E S T I O N   D E S   C O M P O S A N T E S   M U L T I P L E S
************************************************************************
*
*     a) SI L'ON N'A PAS FOURNI DE LISTE DE COMPOSANTES
*     => on verifie que le CHPOINT ne contient qu'une seule composante
*        =============================================================
      IF (MLMOTS.NE.0) GOTO 50
      MCHPOI=ICHPOI
      SEGACT,MCHPOI
      NSOUPO=IPCHP(/1)
      IF (NSOUPO.EQ.0) GOTO 1000
*     /!\ on suppose que la partition est bien faite,
*         c'est-à-dire 1 SOUPO = 1 liste de composante unique)
      IF (NSOUPO.GT.1) GOTO 9
      MSOUPO=IPCHP(1)
      SEGACT,MSOUPO
      IF (NOCOMP(/2).GT.1) GOTO 9
      GOTO 100
*
*     (ERREUR 180 => "Il faut spécifier un champ par point avec une
*                     seule composante")
    9 CALL ERREUR(180)
      RETURN
*
*
*     b) SI ON A SPECIFIE LA LISTE DES COMPOSANTES A SORTIR
*     => on appelle EXCOPP pour faire le travail
*        ==================================================
   50 SEGACT,MLMOTS
      ICO=0
      NCO=MOTS(/2)
*     (label 51 = boucle sur les composantes)
   51 CONTINUE
      IF (ICO.EQ.NCO) GOTO 1000
      ICO=ICO+1
      MCO=MOTS(ICO)
      CALL EXCOPP(ICHPOI,MCO,MCHPOI,MCO,0)
      SEGACT,MCHPOI
      MSOUPO=IPCHP(1)
      SEGACT,MSOUPO
*
*
*
************************************************************************
*   G E S T I O N   D E   L ' O R D R E   D U   L I S T R E E L
************************************************************************
*
*     a) UN MELEME A ETE FOURNI POUR SPECIFIER L'ORDRE DE SORTIE
*        =======================================================
*
  100 CONTINUE
      IF (MELEME.EQ.0) GOTO 200
*
*     On vérifie qu'il est composé uniquement de POI1
      SEGACT,MELEME
      IF (LISOUS(/1).GT.0.OR.ITYPEL.NE.1) THEN
          MOTERR(1:8)='MAILLAGE'
          MOTERR(9:24)='POI1'
          CALL ERREUR(1025)
          RETURN
      ENDIF
*
*     Agrandissement du LISTREEL
      NP1=NUM(/2)
      JG=JG+NP1
      SEGADJ,MLREEL
*
*     Remplissage du LISTREEL selon l'ordre demandé
      IPT1=IGEOC
      MPOVAL=IPOVAL
      SEGACT,IPT1,MPOVAL
      NP2=IPT1.NUM(/2)
      DO 150 I2=1,NP2
          DO I3=1,NP1
              IF (IPT1.NUM(1,I2).EQ.NUM(1,I3)) THEN
                  PROG(JG-NP1+I3)=VPOCHA(I2,1)
                  GOTO 150
              ENDIF
          ENDDO
  150 CONTINUE
*
      SEGDES,MPOVAL,IPT1,MELEME
      GOTO 950
*
*
*     b) ON NE S'INTERESSE PAS A L'ORDRE DE SORTIE
*        => Remplissage du LISTREEL dans l'ordre du VPOCHA
*        =================================================
*
  200 CONTINUE
*
      MPOVAL=IPOVAL
      SEGACT,MPOVAL
      NP2=VPOCHA(/1)
      JG=JG+NP2
      SEGADJ,MLREEL
      DO I2=1,NP2
          PROG(JG-NP2+I2)=VPOCHA(I2,1)
      ENDDO
*
      SEGDES,MPOVAL
*
*
*
  950 CONTINUE
      IF (MLMOTS.NE.0) THEN
          CALL DTCHPO(MCHPOI)
          GOTO 51
      ELSE
          SEGDES,MSOUPO
      ENDIF
*
*
 1000 CONTINUE
      IF (MLMOTS.EQ.0) THEN
          SEGDES,MCHPOI
      ELSE
          SEGDES,MLMOTS
      ENDIF
      SEGDES,MLREEL
*
*
      RETURN
*
      END
*