Sources Esope | Cast3M

extr25
C EXTR25    SOURCE    FD218221  25/12/14    21:15:01     12423          
      SUBROUTINE EXTR25(MCHEL1,MOT,ILIST,IRET)
C
C     Extrait les valeurs d'une composante d'un MCHAML et les range dans
C     - un LISTREEL si la composante est de type REAL*8
C     - un LISTENTI si la composante est de type POINTEUR
C
C  Entrees :
C  ---------
C
C     MCHEL1  Pointeur sur un MCHAML
C     MOT     Nom de la composante a extraire
C
C  Sorties :
C  ---------
C
C     ILIST   Pointeur sur un LISTREEL ou LISTENTI
C     IRET    = 0 si ILIST correspond a un LISTREEL
C             = 1 si ILIST correspond a un LISTENTI
C
 
 
C     Typages implicites habituels
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
C     Les includes necessaires
-INC PPARAM
-INC SMLREEL
-INC SMCHAML
-INC SMINTE
-INC SMELEME
-INC SMLENTI
 
 
C     Type de certains objets
      CHARACTER*(LOCOMP) MOT,TYC
      LOGICAL LREAL
 
C     LRELA indique si l'on doit faire un LISTREEL (.TRUE.) ou
C     un LISTENTI (.FALSE.)
      LREAL=.TRUE.
 
C     Initialisation de la liste resultat
C     On suppose que ce sera un LISTREEL pour le moment
      JG=0
      SEGINI MLREE1
 
C     Nombre de valeurs de la liste
      IV=0
 
C     Boucle sur les sous zones
      NSZ=MCHEL1.IMACHE(/1)
      DO I=1,NSZ
         IPT1=MCHEL1.IMACHE(I)
         MCHAM1=MCHEL1.ICHAML(I)
         MINTE1=MCHEL1.INFCHE(I,4)
         NBPSUP=MINTE1.POIGAU(/1)
         IF (NBPSUP.EQ.0) NBPSUP=IPT1.NUM(/1)
C        Type de la 1ere composante
         TYC=MCHAM1.TYPCHE(1)
C        Si composante non reele, on initialise un LISTENTI
         IF ((LREAL).AND.(TYC.NE.'REAL*8  ')) THEN
            LREAL=.FALSE.
            JG=0
            SEGINI MLENT1
         ENDIF
C        Boucle sur les composantes
         NCO=MCHAM1.IELVAL(/1)
         DO J=1,NCO
C           On ne travaille que sur la composante MOT
            IF (MCHAM1.NOMCHE(J).EQ.MOT) THEN
C              Tableau des valeurs de la composante MOT
               MELVA1=MCHAM1.IELVAL(J)
C              Nombre d'elements du maillage
               NEL=IPT1.NUM(/2)
C              Dimensions du tableau VELCHE
               IF (LREAL) THEN
                 NP=MELVA1.VELCHE(/1)
                 NE=MELVA1.VELCHE(/2)
               ELSE
                 NP=MELVA1.IELCHE(/1)
                 NE=MELVA1.IELCHE(/2)
               ENDIF
C              Ajustement de la liste selon ce tableau VELCHE
               JG=IV+(NEL*NBPSUP)
               IF (LREAL) THEN
                 SEGADJ MLREE1
               ELSE
                 SEGADJ MLENT1
               ENDIF
C              Boucle sur les elements
               DO K=1,NEL
                  KK=K
C                 Champ uniforme dans le maillage ?
                  IF ((NP.EQ.1).AND.(NE.EQ.1)) KK=1
C                 Boucle sur les points supports
                  DO L=1,NBPSUP
                     LL=L
C                    Champ uniforme dans l'element ?
                     IF (NP.EQ.1) LL=1
C                    Remplissage de la liste
                     IF (LREAL) THEN
                       XVAL=MELVA1.VELCHE(LL,KK)
                       IV=IV+1
                       MLREE1.PROG(IV)=XVAL
                     ELSE
                       IVAL=MELVA1.IELCHE(LL,KK)
                       IV=IV+1
                       MLENT1.LECT(IV)=IVAL
                     ENDIF
                  ENDDO
               ENDDO
            ENDIF
         ENDDO
      ENDDO
 
C     Renommage des sorties
      IF (LREAL) THEN
         IRET=0
         ILIST=MLREE1
      ELSE
         SEGSUP MLREE1
         IRET=1
         ILIST=MLENT1
      ENDIF
      RETURN
 
      END