Sources Esope | Cast3M

regma2
C REGMA2    SOURCE    GOUNAND   24/11/06    21:15:17     12073          
      SUBROUTINE REGMA2(MYMEL2,
     $     MYMELE,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : REGMA2
C DESCRIPTION : On transforme un maillage partitionné ou non en maillage
C               partitionné dont les partitions ont un nombre maximal
C               d'éléments.
C
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       : MKIZA
C***********************************************************************
C ENTREES            : MYMEL2
C SORTIES            : MYMELE
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 07/08/06, version initiale
C HISTORIQUE : v1, 07/08/06, 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
      INTEGER NBNN,NBELEM,NBSOUS,NBREF
      POINTEUR MYMELE.MELEME
      POINTEUR MYMEL2.MELEME
      POINTEUR SMEL.MELEME
      POINTEUR SMEL2.MELEME
*
      INTEGER IMPR,IRET
      INTEGER NSOUS
*
      INTEGER NELMAX
      PARAMETER(NELMAX=20000)
*
      SEGMENT MELS
      POINTEUR LISMEL(0).MELEME
      ENDSEGMENT
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans regma2'
      SEGACT MYMEL2
      NSOUS=MYMEL2.LISOUS(/1)
      SEGINI MELS
      DO ISOUS=1,MAX(1,NSOUS)
         IF (NSOUS.EQ.0) THEN
            SMEL2=MYMEL2
         ELSE
            SMEL2=MYMEL2.LISOUS(ISOUS)
            SEGACT SMEL2
         ENDIF
         NSMEL2=SMEL2.NUM(/2)
*         WRITE(IOIMP,*) 'NSMEL2=',NSMEL2
         NPART=((NSMEL2-1)/NELMAX)+1
         ISMEL2=0
         DO IPART=1,NPART
            NBNN=SMEL2.NUM(/1)
            NBELEM=MIN(NSMEL2-ISMEL2,NELMAX)
*            WRITE(IOIMP,*) 'NSMEL=',NBELEM
            NBSOUS=0
            NBREF=0
            SEGINI SMEL
            SMEL.ITYPEL=SMEL2.ITYPEL
            DO IBELEM=1,NBELEM
               DO IBNN=1,NBNN
                  SMEL.NUM(IBNN,IBELEM)=
     $                 SMEL2.NUM(IBNN,ISMEL2+IBELEM)
                  SMEL.ICOLOR(IBELEM)=
     $                 SMEL2.ICOLOR(ISMEL2+IBELEM)
               ENDDO
            ENDDO
            ISMEL2=ISMEL2+NBELEM
            SEGDES SMEL
            LISMEL(**)=SMEL
         ENDDO
         IF (NSOUS.NE.0) THEN
            SEGDES SMEL2
         ENDIF
      ENDDO
      SEGDES MYMEL2
*
      NSOUS=LISMEL(/1)
      NBNN=0
      NBELEM=0
      NBSOUS=NSOUS
      NBREF=0
      SEGINI MYMELE
      DO ISOUS=1,NSOUS
         MYMELE.LISOUS(ISOUS)=LISMEL(ISOUS)
      ENDDO
      SEGDES MYMELE
      SEGSUP MELS
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine regma2'
      RETURN
*
* End of subroutine REGMA2
*
      END