Télécharger ponbpo.eso

Retour à la liste

Numérotation des lignes :

  1. C PONBPO SOURCE PV 20/03/30 21:22:17 10567
  2. SUBROUTINE PONBPO(P2ELPR,MELDUA,
  3. $ POPPOD,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PONBPO
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Maillage + liste indexée d'entiers (poelm2) => liste
  11. C d'entiers (un point)->(nb. de points adjacents
  12. C i.e. appartenant aux mêmes éléments).
  13. C
  14. C Construire la liste d'entiers suivante (POPPOD) :
  15. C * Nombre d'entiers = nb points P1 de MELPRI ;
  16. C * pour chaque P1 : nb. de points P2 de MELDUA avec lesquels il
  17. C a une liaison.
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES : ACTMEL, INIRPL, RPELEM
  24. C APPELES (ESOPE) : OOOETA
  25. C APPELE PAR : MAKPRM
  26. C***********************************************************************
  27. C ENTREES : P2ELPR, MELDUA
  28. C SORTIES : POPPOD
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION : v2, 15/12/99
  32. C HISTORIQUE : v1, 05/10/99, création
  33. C HISTORIQUE : v2, 15/12/99, utilisation de listes chaînées
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMELEME
  46. POINTEUR MELDUA.MELEME
  47. POINTEUR SOUMDU.MELEME
  48. -INC SMLENTI
  49. INTEGER JG
  50. POINTEUR POPPOD.MLENTI
  51. POINTEUR RPDUAL.MLENTI
  52. POINTEUR IWORK.MLENTI
  53. *
  54. * Includes perso
  55. *
  56. *-INC SLSTIND
  57. *
  58. * Segment LSTIND (liste séquentielle indexée)
  59. *
  60. SEGMENT LSTIND
  61. INTEGER IDX(NBM+1)
  62. INTEGER IVAL(NBTVAL)
  63. ENDSEGMENT
  64. *
  65. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  66. *
  67. * NBM : NOMBRE DE MULTIPLETS
  68. * NBTVAL : NOMBRE TOTAL DE VALEURS
  69. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  70. * MULTIPLET DANS LE TABLEAU IVAL
  71. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  72. POINTEUR P2ELPR.LSTIND
  73. INTEGER IMPR,IRET
  74. INTEGER P2LETA
  75. *
  76. INTEGER IELDUA,IPLDU, IPPRI
  77. INTEGER NUMELD,NBPLDU,NPPRI
  78. INTEGER NOELDU,NOSODU,NPODUA
  79. INTEGER LDG,ILDG,LAST,IPREC
  80. *
  81. * Executable statements
  82. *
  83. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ponbpo'
  84. CALL OOOETA(P2ELPR,P2LETA,IMOD)
  85. IF (P2LETA.NE.1) SEGACT P2ELPR
  86. NPPRI=P2ELPR.IDX(/1)-1
  87. JG=nbpts
  88. SEGINI IWORK
  89. * Activations
  90. CALL ACTMEL(MELDUA)
  91. * In INIRPL : SEGINI RPDUAL
  92. CALL INIRPL(MELDUA,
  93. $ RPDUAL,
  94. $ IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. JG=NPPRI
  97. SEGINI POPPOD
  98. DO 5 IPPRI=1,NPPRI
  99. LDG=0
  100. * Fin de la liste chaînée
  101. LAST=-1
  102. DO 52 IELDUA=P2ELPR.IDX(IPPRI),
  103. $ P2ELPR.IDX(IPPRI+1)-1
  104. NUMELD=P2ELPR.IVAL(IELDUA)
  105. CALL RPELEM(NUMELD,RPDUAL,
  106. $ NOSODU,NOELDU,
  107. $ IMPR,IRET)
  108. IF (IRET.NE.0) GOTO 9999
  109. IF (NOSODU.NE.0) THEN
  110. SOUMDU=MELDUA.LISOUS(NOSODU)
  111. ELSE
  112. SOUMDU=MELDUA
  113. ENDIF
  114. NBPLDU=SOUMDU.NUM(/1)
  115. DO 522 IPLDU=1,NBPLDU
  116. NPODUA=SOUMDU.NUM(IPLDU,NOELDU)
  117. IF (IWORK.LECT(NPODUA).EQ.0) THEN
  118. LDG=LDG+1
  119. IWORK.LECT(NPODUA)=LAST
  120. LAST=NPODUA
  121. ENDIF
  122. 522 CONTINUE
  123. 52 CONTINUE
  124. * Le nombre de points distincts trouvés est:
  125. POPPOD.LECT(IPPRI)=LDG
  126. * On remet la liste chaînée à 0
  127. DO 54 ILDG=1,LDG
  128. IPREC=IWORK.LECT(LAST)
  129. IWORK.LECT(LAST)=0
  130. LAST=IPREC
  131. 54 CONTINUE
  132. 5 CONTINUE
  133. SEGDES POPPOD
  134. SEGSUP RPDUAL
  135. CALL DESMEL(MELDUA)
  136. SEGSUP IWORK
  137. IF (P2LETA.NE.1) SEGDES P2ELPR
  138. *
  139. * Normal termination
  140. *
  141. IRET=0
  142. RETURN
  143. *
  144. * Format handling
  145. *
  146. *
  147. * Error handling
  148. *
  149. 9999 CONTINUE
  150. IRET=1
  151. WRITE(IOIMP,*) 'An error was detected in subroutine ponbpo'
  152. RETURN
  153. *
  154. * End of subroutine PONBPO
  155. *
  156. END
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  

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