Sources Esope | Cast3M

le2mel
C LE2MEL    SOURCE    CHAT      05/01/13    01:14:20     5004
      SUBROUTINE LE2MEL(MLELEM,MELEME,IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : LE2MEL
C DESCRIPTION : Construit un MELEME d'éléments POLY à
C               partir d'une liste séquentielle indexée d'éléments
C               voir le segment MLELEM
C               En gros, on regroupe les éléments qui ont le meme
C               nombre de points.
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          : -
C APPELES (E/S)    : ECROBJ, PRLIST (opérateur 'LIST')
C APPELES (BLAS)   : -
C APPELES (CALCUL) : -
C APPELE PAR       : POIELE, ELPOEL
C***********************************************************************
C SYNTAXE GIBIANE    : -
C ENTREES            : MLELEM (type MLELEM) : liste séquentielle
C                            indexée d'éléments
C ENTREES/SORTIES    : -
C SORTIES            : MELEME ( "  MELEME) : maillage de POLY
C                            associé aux entrées.
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 08/10/98, version initiale
C HISTORIQUE : v1, 08/10/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
-INC SMLENTI
      POINTEUR PONBEL.MLENTI
      POINTEUR MTYPL.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
*
      INTEGER IMPR,IRET
      INTEGER MAXPOI,NTYPL
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans le2mel.eso'
      SEGACT MLELEM
      NBL=INDEX(/1)-1
*
* On construit le tableau temporaire PONBEL tel que :
* PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM
*
* On calcule aussi le maximum du nombre de points des éléments de
* MLELEM.
*
      JG=NBL
      SEGINI PONBEL
      MAXPOI=0
      DO 1 INBL=1,NBL
         PONBEL.LECT(INBL)=INDEX(INBL+1)-INDEX(INBL)
         MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL))
 1    CONTINUE
*
*    Maintenant on détermine le nombre de sous-objets (LISOUS)
*    que devra comporter MELEME, cad le nombre de type d'éléments
*    différents (distingués par le nombre de noeuds)
*    MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant
*    NONOEU noeuds (éventuellement nul).
*    NTYPL contient le nombre de type d'éléments différents
*    à créer.
*
      JG=MAXPOI
      SEGINI MTYPL
      DO 2 INBL=1,NBL
         NONOEU=PONBEL.LECT(INBL)
         MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1
 2    CONTINUE
      NTYPL=0
      DO 3 IMAXPO=1,MAXPOI
         IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1
 3    CONTINUE
*
*    On construit le MELEME en distinguant le cas NTYPL=1...
*
      IF (NTYPL.EQ.1) THEN
         NBSOUS=0
         NBNN=MAXPOI
         NBELEM=NBL
         NBREF=0
         SEGINI MELEME
*     Type d'élément : POLY (cf. bdata.eso)
         ITYPEL=32
         DO 5 INBEL=1,NBL
            IDELEM=INDEX(INBEL)-1
            DO 52 INBNN=1,MAXPOI
               NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
 52         CONTINUE
 5       CONTINUE
         SEGDES MELEME
      ELSE
         NBSOUS=NTYPL
         NBNN=0
         NBELEM=0
         NBREF=0
         SEGINI MELEME
         NBNOEU=0
         DO 7 INBSO=1,NTYPL
*     On cherche le nombre de noeuds du type d'éléments suivant
            NBNOEU=NBNOEU+1
 72         CONTINUE
            IF (MTYPL.LECT(NBNOEU).EQ.0) THEN
               NBNOEU=NBNOEU+1
               GOTO 72
            ENDIF
            NBSOUS=0
*     On stockera le sommet en premier
            NBNN=NBNOEU
            NBELEM=MTYPL.LECT(NBNOEU)
            NBREF=0
            SEGINI IPT1
            IPT1.ITYPEL=32
            IELEM=0
            DO 74 INBEL=1,NBELEM
               IELEM=IELEM+1
 742           CONTINUE
               IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN
                  IELEM=IELEM+1
                  GOTO 742
               ENDIF
               IDELEM=INDEX(IELEM)-1
               DO 744 INBNN=1,NBNN
                  IPT1.NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
 744              CONTINUE
 74            CONTINUE
            SEGDES IPT1
            MELEME.LISOUS(INBSO)=IPT1
 7       CONTINUE
         SEGDES MELEME
      ENDIF
      SEGSUP MTYPL
      SEGDES MLELEM
      SEGDES PONBEL
      IF (IMPR.GT.2) THEN
         WRITE(IOIMP,*) 'On a créé MELEME=',MELEME
         IF (IMPR.GT.3) THEN
            CALL ECROBJ('MAILLAGE',MELEME)
            CALL PRLIST
         ENDIF
      ENDIF
*
* 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 le2mel'
      RETURN
*
* End of subroutine LE2MEL
*
      END