Télécharger ponbl2.eso

Retour à la liste

Numérotation des lignes :

  1. C PONBL2 SOURCE CHAT 05/01/13 02:17:31 5004
  2. SUBROUTINE PONBL2(MAIL,KRIPO1,NPOMAX,
  3. $ PONBEL,IMPR,IRET)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM : PONBL2
  8. C DESCRIPTION : Maillage + tableau repérage de points => liste d'entiers
  9. C (un point)->(nb. d'éléments du maillage le contenant).
  10. C
  11. C Construit une liste d'entiers : PONBEL (type MLENTI)
  12. C PONBEL(i) est le nombre d'éléments de MAIL
  13. C contenant un point dont le numéro n
  14. C est tel que KRIPO1(n)=i.
  15. C La dimension de PONBEL est NPOMAX
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES :
  22. C APPELE PAR : MAKPRM
  23. C***********************************************************************
  24. C SYNTAXE GIBIANE : -
  25. C ENTREES :
  26. C ENTREES/SORTIES : -
  27. C SORTIES : PONBEL (type MLENTI)
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 20/05/99, version initiale
  31. C HISTORIQUE : v1, 20/05/99, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. -INC CCOPTIO
  40. -INC SMELEME
  41. POINTEUR MAIL.MELEME
  42. POINTEUR SOUMAI.MELEME
  43. -INC SMLENTI
  44. INTEGER JG
  45. POINTEUR PONBEL.MLENTI
  46. POINTEUR KRIPO1.MLENTI
  47. *
  48. INTEGER IMPR,IRET
  49. INTEGER MAETA,KRETA,SMETA
  50. INTEGER INBEL,INBNO,INBSOU
  51. INTEGER NBEL, NBNO,NBSOUS,NUMNO,NLOCP1,NPOMAX
  52. *
  53. * Executable statements
  54. *
  55. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ponbl2.eso'
  56. CALL OOOETA(KRIPO1,KRETA)
  57. IF (KRETA.NE.1) SEGACT KRIPO1
  58. JG=NPOMAX
  59. SEGINI PONBEL
  60. *
  61. * Parcourons le maillage
  62. *
  63. CALL OOOETA(MAIL,MAETA)
  64. IF (MAETA.NE.1) SEGACT MAIL
  65. NBSOUS=MAX(1,MAIL.LISOUS(/1))
  66. DO 1 INBSOU=1,NBSOUS
  67. IF (NBSOUS.EQ.1) THEN
  68. SOUMAI=MAIL
  69. ELSE
  70. SOUMAI=MAIL.LISOUS(INBSOU)
  71. CALL OOOETA(SOUMAI,SMETA)
  72. IF (SMETA.NE.1) SEGACT SOUMAI
  73. ENDIF
  74. NBNO=SOUMAI.NUM(/1)
  75. NBEL=SOUMAI.NUM(/2)
  76. DO 12 INBEL=1,NBEL
  77. DO 122 INBNO=1,NBNO
  78. NUMNO=SOUMAI.NUM(INBNO,INBEL)
  79. NLOCP1=KRIPO1.LECT(NUMNO)
  80. IF (NLOCP1.NE.0) THEN
  81. PONBEL.LECT(NLOCP1)=PONBEL.LECT(NLOCP1)+1
  82. ENDIF
  83. 122 CONTINUE
  84. 12 CONTINUE
  85. IF (NBSOUS.NE.1.AND.SMETA.NE.1) SEGDES SOUMAI
  86. 1 CONTINUE
  87. IF (MAETA.NE.1) SEGDES MAIL
  88. IF (KRETA.NE.1) SEGDES KRIPO1
  89. SEGDES PONBEL
  90. *
  91. * Normal termination
  92. *
  93. IRET=0
  94. RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101. 9999 CONTINUE
  102. IRET=1
  103. WRITE(IOIMP,*) 'An error was detected in subroutine ponbl2'
  104. RETURN
  105. *
  106. * End of subroutine PONBL2
  107. *
  108. END
  109.  
  110.  
  111.  
  112.  

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