Sources Esope | Cast3M

extr23
C EXTR23    SOURCE    CB215821  20/11/25    13:28:41     10792          
************************************************************************
* 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 :  31/05/2016 : JCARDO : nouvel argument IVID permettant
*                                     d'ignorer l'erreur quand une
*                                     composante n'existe pas
* 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 CHPO1 'VALE' (MOT1|LMOT1) (POIN1|MAIL1) ('NOID') ;
*
************************************************************************
      SUBROUTINE EXTR23(ICHPOI,MLMOTS,MELEME,MLREEL,IVID)
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMLREEL
-INC SMLMOTS
*
      CHARACTER*(LOCOMP) 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)
 
      NBCOMP=0
      DO ii=1,NSOUPO
        MSOUPO=MCHPOI.IPCHP(ii)
        SEGACT,MSOUPO
        NBCOMP=NBCOMP+MSOUPO.NOCOMP(/2)
      ENDDO
 
      IF (NSOUPO.GT.1) GOTO 9
      IF (NBCOMP.GT.1) GOTO 9
      GOTO 100
*
*     (ERREUR 761 => "L'objet %m1:8 ayant au moins %i1 composantes,
*                     precisez le nom de la composante a traiter.")
    9 MOTERR(1:8)='CHPOINT'
      INTERR(1)=NBCOMP
      CALL ERREUR(761)
      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,NIFOUR,MCHPOI,MCO,NIFOUR,IVID)
      IF (IERR.NE.0) RETURN
      SEGACT,MCHPOI
      NSOUPO=IPCHP(/1)
      IF (NSOUPO.GT.1) THEN
         MOTERR(1:8)='EXTR23'
         CALL ERREUR(1039)
         RETURN
      ENDIF
*
*
*
************************************************************************
*   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é
      IF (NSOUPO.EQ.0) GOTO 950
      MSOUPO=IPCHP(1)
      SEGACT,MSOUPO
      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
 
      GOTO 950
*
*
*     b) ON NE S'INTERESSE PAS A L'ORDRE DE SORTIE
*        => Remplissage du LISTREEL dans l'ordre du VPOCHA
*        =================================================
*
  200 CONTINUE
*
      IF (NSOUPO.EQ.0) GOTO 950
      MSOUPO=IPCHP(1)
      SEGACT,MSOUPO
      MPOVAL=IPOVAL
      SEGACT,MPOVAL
      NP2=VPOCHA(/1)
      JG=JG+NP2
      SEGADJ,MLREEL
      DO I2=1,NP2
          PROG(JG-NP2+I2)=VPOCHA(I2,1)
      ENDDO
*
*
*
  950 CONTINUE
      IF (MLMOTS.NE.0) THEN
          CALL DTCHPO(MCHPOI)
          GOTO 51
      ENDIF
*
*
 1000 CONTINUE
*
      END