Télécharger la plaquette Cast3M


fr en

Télécharger regma2.eso

Retour à la liste

Numérotation des lignes : 

regma2

  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMELEME
  37.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  38.       POINTEUR MYMELE.MELEME
  39.       POINTEUR MYMEL2.MELEME
  40.       POINTEUR SMEL.MELEME
  41.       POINTEUR SMEL2.MELEME
  42. *
  43.       INTEGER IMPR,IRET
  44.       INTEGER NSOUS
  45. *
  46.       INTEGER NELMAX
  47.       PARAMETER(NELMAX=20000)
  48. *
  49.       SEGMENT MELS
  50.       POINTEUR LISMEL(0).MELEME
  51.       ENDSEGMENT
  52. *
  53. * Executable statements
  54. *
  55.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans regma2'
  56.       SEGACT MYMEL2
  57.       NSOUS=MYMEL2.LISOUS(/1)
  58.       SEGINI MELS
  59.       DO ISOUS=1,MAX(1,NSOUS)
  60.          IF (NSOUS.EQ.0) THEN
  61.             SMEL2=MYMEL2
  62.          ELSE
  63.             SMEL2=MYMEL2.LISOUS(ISOUS)
  64.             SEGACT SMEL2
  65.          ENDIF
  66.          NSMEL2=SMEL2.NUM(/2)
  67. *         WRITE(IOIMP,*) 'NSMEL2=',NSMEL2
  68.          NPART=((NSMEL2-1)/NELMAX)+1
  69.          ISMEL2=0
  70.          DO IPART=1,NPART
  71.             NBNN=SMEL2.NUM(/1)
  72.             NBELEM=MIN(NSMEL2-ISMEL2,NELMAX)
  73. *            WRITE(IOIMP,*) 'NSMEL=',NBELEM
  74.             NBSOUS=0
  75.             NBREF=0
  76.             SEGINI SMEL
  77.             SMEL.ITYPEL=SMEL2.ITYPEL
  78.             DO IBELEM=1,NBELEM
  79.                DO IBNN=1,NBNN
  80.                   SMEL.NUM(IBNN,IBELEM)=
  81.      $                 SMEL2.NUM(IBNN,ISMEL2+IBELEM)
  82.                ENDDO
  83.             ENDDO
  84.             ISMEL2=ISMEL2+NBELEM
  85.             SEGDES SMEL
  86.             LISMEL(**)=SMEL
  87.          ENDDO
  88.          IF (NSOUS.NE.0) THEN
  89.             SEGDES SMEL2
  90.          ENDIF
  91.       ENDDO
  92.       SEGDES MYMEL2
  93. *
  94.       NSOUS=LISMEL(/1)
  95.       NBNN=0
  96.       NBELEM=0
  97.       NBSOUS=NSOUS
  98.       NBREF=0
  99.       SEGINI MYMELE
  100.       DO ISOUS=1,NSOUS
  101.          MYMELE.LISOUS(ISOUS)=LISMEL(ISOUS)
  102.       ENDDO
  103.       SEGDES MYMELE
  104.       SEGSUP MELS
  105. *
  106. * Normal termination
  107. *
  108.       IRET=0
  109.       RETURN
  110. *
  111. * Format handling
  112. *
  113. *
  114. * Error handling
  115. *
  116.  9999 CONTINUE
  117.       IRET=1
  118.       WRITE(IOIMP,*) 'An error was detected in subroutine regma2'
  119.       RETURN
  120. *
  121. * End of subroutine REGMA2
  122. *
  123.       END
  124.  
  125.  
  126.  
  127.  
  128.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales