Télécharger regma2.eso

Retour à la liste

Numérotation des lignes :

  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