Télécharger extr25.eso

Retour à la liste

extr25
C EXTR25    SOURCE    FD218221  25/03/13    21:15:01     12195          
      SUBROUTINE EXTR25(MCHEL1,MOT)
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  La liste resultat est ecrite dans la pile
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     Ecriture de la liste dans la pile et sortie
      IF (LREAL) THEN
         CALL ECROBJ('LISTREEL',MLREE1)
      ELSE
         SEGSUP MLREE1
         CALL ECROBJ('LISTENTI',MLENT1)
      ENDIF
      RETURN
 
      END
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales