Télécharger popoin.eso

Retour à la liste

Numérotation des lignes :

  1. C POPOIN SOURCE CHAT 05/01/13 02:17:47 5004
  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. -INC CCOPTIO
  41. -INC SMCOORD
  42. -INC SMELEME
  43. POINTEUR MELDUA.MELEME
  44. POINTEUR SOUMDU.MELEME
  45. -INC SMLENTI
  46. INTEGER JG
  47. POINTEUR POPPOD.MLENTI
  48. POINTEUR RPDUAL.MLENTI
  49. POINTEUR IWORK.MLENTI
  50. *
  51. * Includes persos
  52. *
  53. *-INC SLSTIND
  54. *
  55. * Segment LSTIND (liste séquentielle indexée)
  56. *
  57. SEGMENT LSTIND
  58. INTEGER IDX(NBM+1)
  59. INTEGER IVAL(NBTVAL)
  60. ENDSEGMENT
  61. *
  62. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  63. *
  64. * NBM : NOMBRE DE MULTIPLETS
  65. * NBTVAL : NOMBRE TOTAL DE VALEURS
  66. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  67. * MULTIPLET DANS LE TABLEAU IVAL
  68. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  69. POINTEUR P2ELPR.LSTIND
  70. POINTEUR LPPPD.LSTIND
  71. *
  72. INTEGER IMPR,IRET
  73. *
  74. INTEGER POETA,P2LETA
  75. INTEGER ILPPPD,IDEPA,IELDUA,IPLDU,IPPRI
  76. INTEGER NBTVAL,NOELDU,NOSODU,NPODUA,NBPLDU,NPPRI,NUMELD,NBM
  77. *
  78. * Executable statements
  79. *
  80. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans popoin.eso'
  81. CALL OOOETA(POPPOD,POETA)
  82. IF (POETA.NE.1) SEGACT POPPOD
  83. NPPRI=POPPOD.LECT(/1)
  84. C On initialise le segment LPPPD
  85. NBM=NPPRI
  86. NBTVAL=0
  87. SEGINI LPPPD
  88. IDEPA=1
  89. DO 2 IPPRI=1,NPPRI
  90. LPPPD.IDX(IPPRI)=IDEPA
  91. IDEPA=IDEPA+POPPOD.LECT(IPPRI)
  92. 2 CONTINUE
  93. LPPPD.IDX(NPPRI+1)=IDEPA
  94. IF (POETA.NE.1) SEGDES POPPOD
  95. NBTVAL=IDEPA-1
  96. SEGADJ LPPPD
  97. * Activations
  98. CALL OOOETA(P2ELPR,P2LETA)
  99. IF (P2LETA.NE.1) SEGACT P2ELPR
  100. JG=XCOOR(/1)/(IDIM+1)
  101. SEGINI IWORK
  102. CALL ACTMEL(MELDUA)
  103. * In INIRPL : SEGINI RPDUAL
  104. CALL INIRPL(MELDUA,
  105. $ RPDUAL,
  106. $ IMPR,IRET)
  107. IF (IRET.NE.0) GOTO 9999
  108. *
  109. * Parcourons le maillage
  110. *
  111. DO 5 IPPRI=1,NPPRI
  112. ILPPPD=LPPPD.IDX(IPPRI)-1
  113. DO 52 IELDUA=P2ELPR.IDX(IPPRI),
  114. $ P2ELPR.IDX(IPPRI+1)-1
  115. NUMELD=P2ELPR.IVAL(IELDUA)
  116. CALL RPELEM(NUMELD,RPDUAL,
  117. $ NOSODU,NOELDU,
  118. $ IMPR,IRET)
  119. IF (IRET.NE.0) GOTO 9999
  120. IF (NOSODU.NE.0) THEN
  121. SOUMDU=MELDUA.LISOUS(NOSODU)
  122. ELSE
  123. SOUMDU=MELDUA
  124. ENDIF
  125. NBPLDU=SOUMDU.NUM(/1)
  126. DO 522 IPLDU=1,NBPLDU
  127. NPODUA=SOUMDU.NUM(IPLDU,NOELDU)
  128. IF (IWORK.LECT(NPODUA).EQ.0) THEN
  129. ILPPPD=ILPPPD+1
  130. LPPPD.IVAL(ILPPPD)=NPODUA
  131. IWORK.LECT(NPODUA)=ILPPPD
  132. ENDIF
  133. 522 CONTINUE
  134. 52 CONTINUE
  135. * On remet le segment de travail à zéro
  136. DO 54 ILPPPD=LPPPD.IDX(IPPRI),LPPPD.IDX(IPPRI+1)-1
  137. IWORK.LECT(LPPPD.IVAL(ILPPPD))=0
  138. 54 CONTINUE
  139. 5 CONTINUE
  140. SEGSUP RPDUAL
  141. CALL DESMEL(MELDUA)
  142. SEGSUP IWORK
  143. IF (P2LETA.NE.1) SEGDES P2ELPR
  144. SEGDES LPPPD
  145. *
  146. * Normal termination
  147. *
  148. IRET=0
  149. RETURN
  150. *
  151. * Format handling
  152. *
  153. *
  154. * Error handling
  155. *
  156. 9999 CONTINUE
  157. IRET=1
  158. WRITE(IOIMP,*) 'An error was detected in subroutine popoin'
  159. RETURN
  160. *
  161. * End of subroutine POPOIN
  162. *
  163. END
  164.  
  165.  
  166.  
  167.  

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