Sources Esope | Cast3M

poelem
C POELEM    SOURCE    CHAT      05/01/13    02:16:22     5004
      SUBROUTINE POELEM(MCLAS,MCLPO1,MCENT,PONBEL,
     $     LEPOEL,IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : POELEM
C DESCRIPTION : On construit la liste séquentielle indexée
C               d'éléments LEPOEL (type MLELEM).
*               NOPOI1 : indice du point considéré dans MCLPO1
*               LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) :
*                  contient le numéro du point considéré
*               LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1
*                          -> LEPOEL.INDEX(NOPOI1+1)-1) :
*                  contient les numéros des points centre des
*                  éléments de MCLAS contenant le point considéré (!)
*
*        PONBEL est tel que PONBEL(NOPOI1) = nb d'éléments
*                                            contenant le POI1
*              (NOPOI1 est le numéro local du point dans MCLPO1)
*
*        PONBEL est calculé dans la subroutine ponbel.eso
*        Il sert à dimensionner le tableau LESPOI et remplir
*        le tableau INDEX du segment LEPOEL.
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : KRIPAD : MELEME -> (num. globale->locale)
C APPELES (E/S)    : -
C APPELES (BLAS)   : -
C APPELES (CALCUL) : -
C APPELE PAR       : POIELE, ELPOEL
C***********************************************************************
C SYNTAXE GIBIANE    : -
C ENTREES            : MCLAS (type MELEME)  : maillage de classe de
C                                             points (sommet, face) par
C                                             élément (MMAIL,ELTFA)
C                      MCLPO1 (type MELEME) : maillage de points
C                                             correspondant à MCLAS
C                      MCENT  (type MELEME) : un maillage de
C                           points (dits 'centres') ayant le meme
C                           nombre d'éléments que MCLAS et
C                           servant à repérer les éléments de MCLAS.
C                      PONBEL (type MLENTI) : une liste indiquant
C                           à combien d'éléments de MCLAS appartient
C                           un point de MCLPO1.
C
C ENTREES/SORTIES    : -
C SORTIES            : LEPOEL (type MLELEM) : liste séquentielle indexée
C                                             d'éléments (cf. plus haut)
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 02/11/98, version initiale
C HISTORIQUE : v1, 02/11/98, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      POINTEUR MCLAS.MELEME
      POINTEUR MCLPO1.MELEME
      POINTEUR MCENT.MELEME
-INC SMLENTI
      POINTEUR PONBEL.MLENTI
      POINTEUR KRIPO1.MLENTI
*
*     Segment MLELEM
*
      SEGMENT MLELEM
      INTEGER INDEX(NBL+1)
      INTEGER LESPOI(NBTPOI)
      ENDSEGMENT
*
*     LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
*
*     NBL      : NOMBRE D'ELEMENTS
*     NBTPOI   : NOMBRE TOTAL DE POINTS REFERENCEES
*     INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
*                DANS LE TABLEAU LESPOI
*     LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
*                DU IEME ELEMENT
*
      POINTEUR LEPOEL.MLELEM
      POINTEUR ICOUR.MLELEM
      INTEGER IMPR,IRET
      INTEGER NBL,NBTPOI
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poelem.eso'
      SEGACT MCLPO1
      NBSOUS=MCLPO1.LISOUS(/1)
      NOTYP =MCLPO1.ITYPEL
      IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
         WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
         GOTO 9999
      ENDIF
      NBPOI1=MCLPO1.NUM(/2)
      SEGACT PONBEL
      NPONB=PONBEL.LECT(/1)
      IF (NPONB.NE.NBPOI1) THEN
         WRITE(IOIMP,*) 'Dimension of MCLPO1 and PONBEL are not equal'
         GOTO 9999
      ENDIF
C   On initialise le segment LEPOEL (type MLELEM)
C              et le segment ICOUR  (type MLELEM)
C     dans ICOUR, seul le tableau INDEX nous intéresse
      NBL=NBPOI1
      NBTPOI=0
      SEGINI LEPOEL
      IDEPA=1
      DO 2 INBL=1,NBL
         LEPOEL.INDEX(INBL)=IDEPA
         IDEPA=IDEPA+1+PONBEL.LECT(INBL)
 2    CONTINUE
      LEPOEL.INDEX(NBL+1)=IDEPA
      SEGDES PONBEL
      SEGINI,ICOUR=LEPOEL
      NBTPOI=IDEPA-1
      SEGADJ LEPOEL
C
C     On remplit LESPOI(INDEX(I)) avec le numéro du Ieme point
C     de MCLPO1.
C
      DO 3 INBL=1,NBL
         LEPOEL.LESPOI(ICOUR.INDEX(INBL))=MCLPO1.NUM(1,INBL)
         ICOUR.INDEX(INBL)=ICOUR.INDEX(INBL)+1
 3    CONTINUE
C   In KRIPAD : SEGINI KRIPO1
      CALL KRIPAD(MCLPO1,KRIPO1)
      SEGDES MCLPO1
C
C     On remplit LESPOI(INDEX(I)+1 -> INDEX(I+1)-1)
C     avec les points centres des éléments contenant le
C     Ieme point de MCLPO1.
C
C     On procède en bouclant sur les éléments de MCLAS pour
C     remplir le tableau LESPOI.
C
      SEGACT MCENT
      SEGACT MCLAS
      NBSOUS=MCLAS.LISOUS(/1)
      IF (NBSOUS.EQ.0) NBSOUS=1
      ICENT=0
      DO 4 INBSOU=1,NBSOUS
         IF (NBSOUS.GT.1) THEN
            IPT1=MCLAS.LISOUS(INBSOU)
            SEGACT IPT1
         ELSE
            IPT1=MCLAS
         ENDIF
         NBPOEL=IPT1.NUM(/1)
         NBELEM=IPT1.NUM(/2)
         DO 42 INBEL=1,NBELEM
            ICENT=ICENT+1
            NOCEN=MCENT.NUM(1,ICENT)
            DO 422 INBPO=1,NBPOEL
               NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
               IF (NOPOI1.NE.0) THEN
                  LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN
                  ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1
               ELSE
                  WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
                  WRITE(IOIMP,*) 'le maillage de points correspondant'
                  WRITE(IOIMP,*) 'à MCLAS.'
                  GOTO 9999
               ENDIF
 422        CONTINUE
 42      CONTINUE
         IF (NBSOUS.GT.1) SEGDES IPT1
 4    CONTINUE
      SEGDES MCLAS
      SEGDES MCENT
      IF (IMPR.GT.2) THEN
         WRITE(IOIMP,*) 'On a créé LEPOEL (type MLELEM)=',LEPOEL
         IF (IMPR.GT.3) THEN
            WRITE(IOIMP,4000) 'LEPOEL.INDEX',NBL+1
            WRITE(IOIMP,5000) (LEPOEL.INDEX(I),I=1,NBL+1)
            WRITE(IOIMP,4000) 'LEPOEL.LESPOI',NBTPOI
            WRITE(IOIMP,5000) (LEPOEL.LESPOI(I),I=1,NBTPOI)
         ENDIF
      ENDIF
      SEGDES LEPOEL
      SEGSUP ICOUR
      SEGSUP KRIPO1
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
 4000  FORMAT (A,'(1..',I8,')')
 5000  FORMAT (8(1X,I8))
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine poelem'
      RETURN
*
* End of subroutine POELEM
*
      END