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. -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.  
  126.  

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