Télécharger popoin.eso

Retour à la liste

Numérotation des lignes :

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

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