Esope source files

   1 : C REGMA2    SOURCE    GOUNAND   06/12/19    21:15:34     5612           
   2 :       SUBROUTINE REGMA2(MYMEL2,
   3 :      $     MYMELE,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : REGMA2
   9 : C DESCRIPTION : On transforme un maillage partitionné ou non en maillage 
  10 : C               partitionné dont les partitions ont un nombre maximal
  11 : C               d'éléments.
  12 : C
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELE PAR       : MKIZA
  19 : C***********************************************************************
  20 : C ENTREES            : MYMEL2
  21 : C SORTIES            : MYMELE
  22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23 : C***********************************************************************
  24 : C VERSION    : v1, 07/08/06, version initiale
  25 : C HISTORIQUE : v1, 07/08/06, création
  26 : C HISTORIQUE :
  27 : C HISTORIQUE :
  28 : C***********************************************************************
  29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30 : C en cas de modification de ce sous-programme afin de faciliter
  31 : C la maintenance !
  32 : C***********************************************************************
  33 : -INC CCOPTIO
  34 : -INC SMELEME
  35 :       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  36 :       POINTEUR MYMELE.MELEME
  37 :       POINTEUR MYMEL2.MELEME
  38 :       POINTEUR SMEL.MELEME
  39 :       POINTEUR SMEL2.MELEME
  40 : *
  41 :       INTEGER IMPR,IRET
  42 :       INTEGER NSOUS
  43 : *
  44 :       INTEGER NELMAX
  45 :       PARAMETER(NELMAX=20000)
  46 : *
  47 :       SEGMENT MELS
  48 :       POINTEUR LISMEL(0).MELEME
  49 :       ENDSEGMENT
  50 : *     
  51 : * Executable statements
  52 : *
  53 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans regma2'
  54 :       SEGACT MYMEL2
  55 :       NSOUS=MYMEL2.LISOUS(/1)
  56 :       SEGINI MELS
  57 :       DO ISOUS=1,MAX(1,NSOUS)
  58 :          IF (NSOUS.EQ.0) THEN
  59 :             SMEL2=MYMEL2
  60 :          ELSE
  61 :             SMEL2=MYMEL2.LISOUS(ISOUS)
  62 :             SEGACT SMEL2
  63 :          ENDIF
  64 :          NSMEL2=SMEL2.NUM(/2)
  65 : *         WRITE(IOIMP,*) 'NSMEL2=',NSMEL2
  66 :          NPART=((NSMEL2-1)/NELMAX)+1
  67 :          ISMEL2=0
  68 :          DO IPART=1,NPART
  69 :             NBNN=SMEL2.NUM(/1)
  70 :             NBELEM=MIN(NSMEL2-ISMEL2,NELMAX)
  71 : *            WRITE(IOIMP,*) 'NSMEL=',NBELEM
  72 :             NBSOUS=0
  73 :             NBREF=0
  74 :             SEGINI SMEL
  75 :             SMEL.ITYPEL=SMEL2.ITYPEL
  76 :             DO IBELEM=1,NBELEM
  77 :                DO IBNN=1,NBNN
  78 :                   SMEL.NUM(IBNN,IBELEM)=
  79 :      $                 SMEL2.NUM(IBNN,ISMEL2+IBELEM)
  80 :                ENDDO
  81 :             ENDDO
  82 :             ISMEL2=ISMEL2+NBELEM
  83 :             SEGDES SMEL
  84 :             LISMEL(**)=SMEL
  85 :          ENDDO
  86 :          IF (NSOUS.NE.0) THEN
  87 :             SEGDES SMEL2
  88 :          ENDIF
  89 :       ENDDO
  90 :       SEGDES MYMEL2
  91 : *
  92 :       NSOUS=LISMEL(/1)
  93 :       NBNN=0
  94 :       NBELEM=0
  95 :       NBSOUS=NSOUS
  96 :       NBREF=0
  97 :       SEGINI MYMELE
  98 :       DO ISOUS=1,NSOUS
  99 :          MYMELE.LISOUS(ISOUS)=LISMEL(ISOUS)
 100 :       ENDDO
 101 :       SEGDES MYMELE
 102 :       SEGSUP MELS
 103 : *
 104 : * Normal termination
 105 : *
 106 :       IRET=0
 107 :       RETURN
 108 : *
 109 : * Format handling
 110 : *
 111 : *
 112 : * Error handling
 113 : *
 114 :  9999 CONTINUE
 115 :       IRET=1
 116 :       WRITE(IOIMP,*) 'An error was detected in subroutine regma2'
 117 :       RETURN
 118 : *
 119 : * End of subroutine REGMA2
 120 : *
 121 :       END
 122 : 
 123 :  
 124 :  
 125 :