Sources Esope | Cast3M

mluniq
C MLUNIQ    SOURCE    PV        20/03/30    21:21:14     10567          
      SUBROUTINE MLUNIQ(GPMELS,
     $     KJSPGT,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : MLUNIQ
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Un groupe de maillages => un maillage
C               contenant tous les points.
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELE PAR       : PRASEM
C***********************************************************************
C ENTREES            : GPMELS
C SORTIES            : KJSPGT
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 30/09/99, version initiale
C HISTORIQUE : v1, 30/09/99, 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 SMCOORD
-INC SMELEME
      POINTEUR MELCOU.MELEME
      POINTEUR SOUMEL.MELEME
      INTEGER NBELEM,NBNN,NBREF,NBSOUS
      POINTEUR KJSPGT.MELEME
-INC SMLENTI
      INTEGER JG
      POINTEUR KRSPGT.MLENTI
*
* Includes persos
*
      SEGMENT MELS
      POINTEUR LISMEL(NBMEL).MELEME
      ENDSEGMENT
      POINTEUR GPMELS.MELS
*
      INTEGER IMPR,IRET
*
      INTEGER IMEL,ISOUS,IPOEL,IELEM
      INTEGER NMEL,NSOUS,NPOEL,NELEM
      INTEGER NUMNO
      INTEGER ILDG,LDG,LAST,IPREC
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mluniq'
*
      JG=nbpts
      SEGINI KRSPGT
      SEGACT GPMELS
      NMEL=GPMELS.LISMEL(/1)
*
* Parcourons les maillages
*
*   degré et fin de la liste chaînée
*   le degré de la liste chaînée est aussi le nombre
*   de points de KJSPGT
      LDG=0
      LAST=-1
      DO 1 IMEL=1,NMEL
         MELCOU=GPMELS.LISMEL(IMEL)
         SEGACT MELCOU
         NSOUS=MELCOU.LISOUS(/1)
         DO 12 ISOUS=1,MAX(1,NSOUS)
            IF (NSOUS.EQ.0) THEN
               SOUMEL=MELCOU
            ELSE
               SOUMEL=MELCOU.LISOUS(ISOUS)
               SEGACT SOUMEL
            ENDIF
            NPOEL=SOUMEL.NUM(/1)
            NELEM=SOUMEL.NUM(/2)
            DO 122 IELEM=1,NELEM
               DO 1222 IPOEL=1,NPOEL
                  NUMNO=SOUMEL.NUM(IPOEL,IELEM)
                  IF (KRSPGT.LECT(NUMNO).EQ.0) THEN
                     LDG=LDG+1
                     KRSPGT.LECT(NUMNO)=LAST
                     LAST=NUMNO
                  ENDIF
 1222          CONTINUE
 122        CONTINUE
            IF (NSOUS.NE.0) SEGDES SOUMEL
 12      CONTINUE
         SEGDES MELCOU
 1    CONTINUE
      SEGDES GPMELS
*
* On transère la liste chaînée dans KJSPGT (maillage de points)
*
      NBNN=1
      NBELEM=LDG
      NBSOUS=0
      NBREF=0
      SEGINI KJSPGT
      KJSPGT.ITYPEL=1
      DO 2 ILDG=1,LDG
         IPREC=KRSPGT.LECT(LAST)
         KJSPGT.NUM(1,ILDG)=LAST
         LAST=IPREC
 2    CONTINUE
      SEGDES KJSPGT
      SEGSUP KRSPGT
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine mluniq'
      RETURN
*
* End of subroutine MLUNIQ
*
      END