Télécharger mluniq.eso

Retour à la liste

Numérotation des lignes :

mluniq
  1. C MLUNIQ SOURCE GOUNAND 25/04/30 21:15:22 12258
  2. SUBROUTINE MLUNIQ(GPMELS,
  3. $ KJSPGT,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MLUNIQ
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Un groupe de maillages => un maillage
  11. C contenant tous les points.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELE PAR : PRASEM
  18. C***********************************************************************
  19. C ENTREES : GPMELS
  20. C SORTIES : KJSPGT
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 30/09/99, version initiale
  24. C HISTORIQUE : v1, 30/09/99, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. C en cas de modification de ce sous-programme afin de faciliter
  30. C la maintenance !
  31. C***********************************************************************
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMELEME
  37. POINTEUR MELCOU.MELEME
  38. POINTEUR SOUMEL.MELEME
  39. INTEGER NBELEM,NBNN,NBREF,NBSOUS
  40. POINTEUR KJSPGT.MELEME
  41. -INC SMLENTI
  42. INTEGER JG
  43. POINTEUR KRSPGT.MLENTI
  44. *
  45. * Includes persos
  46. *
  47. SEGMENT MELS
  48. POINTEUR LISMEL(NBMEL).MELEME
  49. ENDSEGMENT
  50. POINTEUR GPMELS.MELS
  51. *
  52. INTEGER IMPR,IRET
  53. *
  54. INTEGER IMEL,ISOUS,IPOEL,IELEM
  55. INTEGER NMEL,NSOUS,NPOEL,NELEM
  56. INTEGER NUMNO
  57. INTEGER ILDG,LDG,LAST,IPREC
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mluniq'
  62. *
  63. JG=nbpts
  64. SEGINI KRSPGT
  65. SEGACT GPMELS
  66. NMEL=GPMELS.LISMEL(/1)
  67. *
  68. * Parcourons les maillages
  69. *
  70. * degré et fin de la liste chaînée
  71. * le degré de la liste chaînée est aussi le nombre
  72. * de points de KJSPGT
  73. LDG=0
  74. LAST=-1
  75. DO 1 IMEL=1,NMEL
  76. MELCOU=GPMELS.LISMEL(IMEL)
  77. SEGACT MELCOU
  78. NSOUS=MELCOU.LISOUS(/1)
  79. DO 12 ISOUS=1,MAX(1,NSOUS)
  80. IF (NSOUS.EQ.0) THEN
  81. SOUMEL=MELCOU
  82. ELSE
  83. SOUMEL=MELCOU.LISOUS(ISOUS)
  84. SEGACT SOUMEL
  85. ENDIF
  86. NPOEL=SOUMEL.NUM(/1)
  87. NELEM=SOUMEL.NUM(/2)
  88. DO 122 IELEM=1,NELEM
  89. DO 1222 IPOEL=1,NPOEL
  90. NUMNO=SOUMEL.NUM(IPOEL,IELEM)
  91. IF (KRSPGT.LECT(NUMNO).EQ.0) THEN
  92. LDG=LDG+1
  93. KRSPGT.LECT(NUMNO)=LAST
  94. LAST=NUMNO
  95. ENDIF
  96. 1222 CONTINUE
  97. 122 CONTINUE
  98. 12 CONTINUE
  99. 1 CONTINUE
  100. *
  101. * On transfère la liste chaînée dans KJSPGT (maillage de points)
  102. *
  103. NBNN=1
  104. NBELEM=LDG
  105. NBSOUS=0
  106. NBREF=0
  107. SEGINI KJSPGT
  108. KJSPGT.ITYPEL=1
  109. DO 2 ILDG=1,LDG
  110. IPREC=KRSPGT.LECT(LAST)
  111. KJSPGT.NUM(1,ILDG)=LAST
  112. LAST=IPREC
  113. 2 CONTINUE
  114. SEGSUP KRSPGT
  115. *
  116. * Normal termination
  117. *
  118. IRET=0
  119. RETURN
  120. *
  121. * Format handling
  122. *
  123. *
  124. * Error handling
  125. *
  126. 9999 CONTINUE
  127. IRET=1
  128. WRITE(IOIMP,*) 'An error was detected in subroutine mluniq'
  129. RETURN
  130. *
  131. * End of subroutine MLUNIQ
  132. *
  133. END
  134.  
  135.  

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