Télécharger ponbl2.eso

Retour à la liste

Numérotation des lignes :

ponbl2
  1. C PONBL2 SOURCE CB215821 19/08/20 21:20:22 10287
  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.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMELEME
  43. POINTEUR MAIL.MELEME
  44. POINTEUR SOUMAI.MELEME
  45. -INC SMLENTI
  46. INTEGER JG
  47. POINTEUR PONBEL.MLENTI
  48. POINTEUR KRIPO1.MLENTI
  49. *
  50. INTEGER IMPR,IRET
  51. INTEGER MAETA,KRETA,SMETA
  52. INTEGER INBEL,INBNO,INBSOU
  53. INTEGER NBEL, NBNO,NBSOUS,NUMNO,NLOCP1,NPOMAX
  54. *
  55. * Executable statements
  56. *
  57. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ponbl2.eso'
  58. CALL OOOETA(KRIPO1,KRETA,IMOD)
  59. IF (KRETA.NE.1) SEGACT KRIPO1
  60. JG=NPOMAX
  61. SEGINI PONBEL
  62. *
  63. * Parcourons le maillage
  64. *
  65. CALL OOOETA(MAIL,MAETA,IMOD)
  66. IF (MAETA.NE.1) SEGACT MAIL
  67. NBSOUS=MAX(1,MAIL.LISOUS(/1))
  68. DO 1 INBSOU=1,NBSOUS
  69. IF (NBSOUS.EQ.1) THEN
  70. SOUMAI=MAIL
  71. ELSE
  72. SOUMAI=MAIL.LISOUS(INBSOU)
  73. CALL OOOETA(SOUMAI,SMETA,IMOD)
  74. IF (SMETA.NE.1) SEGACT SOUMAI
  75. ENDIF
  76. NBNO=SOUMAI.NUM(/1)
  77. NBEL=SOUMAI.NUM(/2)
  78. DO 12 INBEL=1,NBEL
  79. DO 122 INBNO=1,NBNO
  80. NUMNO=SOUMAI.NUM(INBNO,INBEL)
  81. NLOCP1=KRIPO1.LECT(NUMNO)
  82. IF (NLOCP1.NE.0) THEN
  83. PONBEL.LECT(NLOCP1)=PONBEL.LECT(NLOCP1)+1
  84. ENDIF
  85. 122 CONTINUE
  86. 12 CONTINUE
  87. 1 CONTINUE
  88. *
  89. * Normal termination
  90. *
  91. IRET=0
  92. RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99. 9999 CONTINUE
  100. IRET=1
  101. WRITE(IOIMP,*) 'An error was detected in subroutine ponbl2'
  102. *
  103. * End of subroutine PONBL2
  104. *
  105. END
  106.  
  107.  
  108.  

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