Télécharger mklblc.eso

Retour à la liste

Numérotation des lignes :

  1. C MKLBLC SOURCE PV 06/04/16 21:16:53 5405
  2. SUBROUTINE MKLBLC(LMPRIB,KRMPRI,LIPNLC,NELC,
  3. $ LILBLC,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MKLBLC
  9. C DESCRIPTION : Construction d'une liste indexée de correspondance :
  10. C matrice élémentaire B -> liste des matrices élémentaires
  11. C ayant un point de leurs maillages primaux en commun.
  12. C
  13. C
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : -
  20. C APPELE PAR : PROMAT
  21. C***********************************************************************
  22. C ENTREES : LMPRIB, KRMPRI, LIPNLC, NELC
  23. C SORTIES : LILBLC
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 07/02/2000, version initiale
  27. C HISTORIQUE : v1, 07/02/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37. POINTEUR KRMPRI.MLENTI
  38. INTEGER JG
  39. POINTEUR KRELC.MLENTI
  40. * Includes persos
  41. * Segment LSTIND (liste séquentielle indexée)
  42. INTEGER NBM,NBTVAL
  43. SEGMENT LSTIND
  44. INTEGER IDX(NBM+1)
  45. INTEGER IVAL(NBTVAL)
  46. ENDSEGMENT
  47. *-INC SLSTIND
  48. POINTEUR LMPRIB.LSTIND
  49. POINTEUR LIPNLC.LSTIND
  50. POINTEUR LILBLC.LSTIND
  51. *
  52. INTEGER NELC
  53. INTEGER IMPR,IRET
  54. *
  55. INTEGER LDG,NELB
  56. INTEGER IDG,IELB,IELC,ILPOPB
  57. INTEGER IVPRIB,IVSTRT,IVSTOP
  58. INTEGER JVPNLC,JVSTRT,JVSTOP
  59. INTEGER IVLBLC,LAST,PREC
  60. *
  61. * Executable statements
  62. *
  63. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mklblc.eso'
  64. * Dimensionnement de LILBLC
  65. * Pour l'instant LILBLC.IDX(IELB+1)=nombre de matrices élémentaires de
  66. * IMATC reliées à la IELBème matrice élémentaire de IMATB
  67. SEGACT LMPRIB
  68. NELB=LMPRIB.IDX(/1)-1
  69. SEGACT KRMPRI
  70. SEGACT LIPNLC
  71. JG=NELC
  72. SEGINI KRELC
  73. NBM=NELB
  74. NBTVAL=0
  75. SEGINI LILBLC
  76. DO 1 IELB=1,NELB
  77. * Degré et fin de la liste chaînée
  78. LDG=0
  79. LAST=-1
  80. IVSTRT=LMPRIB.IDX(IELB)
  81. IVSTOP=LMPRIB.IDX(IELB+1)-1
  82. DO 12 IVPRIB=IVSTRT,IVSTOP
  83. ILPOPB=KRMPRI.LECT(LMPRIB.IVAL(IVPRIB))
  84. ** pv que faire si ilpopb=0 ?????
  85. if (ilpopb.eq.0) goto 12
  86. JVSTRT=LIPNLC.IDX(ILPOPB)
  87. JVSTOP=LIPNLC.IDX(ILPOPB+1)-1
  88. DO 122 JVPNLC=JVSTRT,JVSTOP
  89. IELC=LIPNLC.IVAL(JVPNLC)
  90. IF (KRELC.LECT(IELC).EQ.0) THEN
  91. LDG=LDG+1
  92. KRELC.LECT(IELC)=LAST
  93. LAST=IELC
  94. ENDIF
  95. 122 CONTINUE
  96. 12 CONTINUE
  97. LILBLC.IDX(IELB+1)=LDG
  98. * Remise à zéro de la liste chaînée
  99. DO 14 IDG=1,LDG
  100. PREC=KRELC.LECT(LAST)
  101. KRELC.LECT(LAST)=0
  102. LAST=PREC
  103. 14 CONTINUE
  104. 1 CONTINUE
  105. * LILBLC.IDX est transformé en la liste d'indexation sur
  106. * LILBLC.IVAL
  107. LILBLC.IDX(1)=1
  108. DO 3 IELB=1,NELB
  109. LILBLC.IDX(IELB+1)=LILBLC.IDX(IELB+1)+LILBLC.IDX(IELB)
  110. 3 CONTINUE
  111. NBM=NELB
  112. NBTVAL=LILBLC.IDX(NELB+1)-1
  113. SEGADJ,LILBLC
  114. * Remplissage de LILBLC
  115. IVLBLC=0
  116. DO 5 IELB=1,NELB
  117. * Degré et fin de la liste chaînée
  118. LDG=0
  119. LAST=-1
  120. IVSTRT=LMPRIB.IDX(IELB)
  121. IVSTOP=LMPRIB.IDX(IELB+1)-1
  122. DO 52 IVPRIB=IVSTRT,IVSTOP
  123. ILPOPB=KRMPRI.LECT(LMPRIB.IVAL(IVPRIB))
  124. ** pv que faire si ilpopb=0 ?????
  125. if (ilpopb.eq.0) goto 52
  126. JVSTRT=LIPNLC.IDX(ILPOPB)
  127. JVSTOP=LIPNLC.IDX(ILPOPB+1)-1
  128. DO 522 JVPNLC=JVSTRT,JVSTOP
  129. IELC=LIPNLC.IVAL(JVPNLC)
  130. IF (KRELC.LECT(IELC).EQ.0) THEN
  131. LDG=LDG+1
  132. KRELC.LECT(IELC)=LAST
  133. LAST=IELC
  134. ENDIF
  135. 522 CONTINUE
  136. 52 CONTINUE
  137. * Remise à zéro de la liste chaînée et vidage dans LILBLC
  138. DO 54 IDG=1,LDG
  139. PREC=KRELC.LECT(LAST)
  140. IVLBLC=IVLBLC+1
  141. LILBLC.IVAL(IVLBLC)=LAST
  142. KRELC.LECT(LAST)=0
  143. LAST=PREC
  144. 54 CONTINUE
  145. 5 CONTINUE
  146. SEGDES LILBLC
  147. SEGSUP KRELC
  148. SEGDES LIPNLC
  149. SEGDES KRMPRI
  150. SEGDES LMPRIB
  151. *
  152. * Normal termination
  153. *
  154. IRET=0
  155. RETURN
  156. *
  157. * Format handling
  158. *
  159. *
  160. * Error handling
  161. *
  162. 9999 CONTINUE
  163. IRET=1
  164. WRITE(IOIMP,*) 'An error was detected in subroutine mklblc'
  165. RETURN
  166. *
  167. * End of subroutine MKLBLC
  168. *
  169. END
  170.  
  171.  
  172.  
  173.  
  174.  

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