Télécharger exmali.eso

Retour à la liste

Numérotation des lignes :

  1. C EXMALI SOURCE PV 16/11/17 21:59:22 9180
  2. SUBROUTINE EXMALI(IMAT,LNBME,LELEM,
  3. $ LMATR,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : EXMALI
  9. C DESCRIPTION : Matrice + liste de noms de composantes + liste de numéro
  10. C d'élément => extraction et stockage dans un tableau de
  11. C listes indexées.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : ACTIMA, DESIMA, INIRPM, RPELEM
  19. C APPELE PAR : PROMAT
  20. C***********************************************************************
  21. C ENTREES : IMAT, LNBME, LELEM
  22. C SORTIES : LMATR
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 08/02/2000, version initiale
  26. C HISTORIQUE : v1, 08/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. -INC SMLENTI
  36. POINTEUR LNBME.MLENTI
  37. POINTEUR LELEM.MLENTI
  38. POINTEUR RPMAT.MLENTI
  39. POINTEUR IMAT.IMATRI
  40. POINTEUR SIMAT.IZAFM
  41. * Includes persos
  42. * Segment LSRIND (liste séquentielle indexée)
  43. SEGMENT LSRIND
  44. INTEGER IDXX(NBM+1)
  45. REAL*8 XVAL(NBTVAL)
  46. ENDSEGMENT
  47. INTEGER NBM,NBTVAL
  48. POINTEUR SLMAT1.LSRIND
  49. POINTEUR SLMATR.LSRIND
  50. SEGMENT LLI
  51. POINTEUR LISLI(NBME).LSRIND
  52. ENDSEGMENT
  53. INTEGER NBME
  54. POINTEUR LMATR.LLI
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. INTEGER NELEM,NNBME,NPP,NPD
  59. INTEGER IELEM,INBME,IPP,IPD,IBME
  60. INTEGER IVMATR,NUELEM,NOSOMA,NUELMA
  61. INTEGER NPPD
  62. *
  63. * Executable statements
  64. *
  65. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmali.eso'
  66. CALL ACTIMA(IMAT)
  67. CALL INIRPM(IMAT,
  68. $ RPMAT,
  69. $ IMPR,IRET)
  70. IF (IRET.NE.0) GOTO 9999
  71. * Dimensionnment de LMATR
  72. SEGACT LNBME
  73. NNBME=LNBME.LECT(/1)
  74. NBME=NNBME
  75. SEGINI LMATR
  76. * Dimensionnement des SLMATR stocké dans SLMAT1
  77. SEGACT RPMAT
  78. SEGACT LELEM
  79. NELEM=LELEM.LECT(/1)
  80. NBM=NELEM
  81. NBTVAL=0
  82. SEGINI SLMAT1
  83. DO 1 IELEM=1,NELEM
  84. NUELEM=LELEM.LECT(IELEM)
  85. CALL RPELEM(NUELEM,RPMAT,
  86. $ NOSOMA,NUELMA,
  87. $ IMPR,IRET)
  88. IF (IRET.NE.0) GOTO 9999
  89. NOSOMA=MAX(1,NOSOMA)
  90. SIMAT=IMAT.LIZAFM(NOSOMA,1)
  91. NPP=SIMAT.AM(/2)
  92. NPD=SIMAT.AM(/3)
  93. NPPD=NPP*NPD
  94. SLMAT1.IDXX(IELEM+1)=NPPD
  95. 1 CONTINUE
  96. SLMAT1.IDXX(1)=1
  97. DO 3 IELEM=1,NELEM
  98. SLMAT1.IDXX(IELEM+1)=SLMAT1.IDXX(IELEM+1)+SLMAT1.IDXX(IELEM)
  99. 3 CONTINUE
  100. * Remplissage des SLMATR
  101. DO 5 INBME=1,NNBME
  102. IBME=LNBME.LECT(INBME)
  103. NBM=NELEM
  104. NBTVAL=SLMAT1.IDXX(NELEM+1)-1
  105. SEGINI SLMATR
  106. SLMATR.IDXX(1)=1
  107. IVMATR=0
  108. DO 52 IELEM=1,NELEM
  109. NUELEM=LELEM.LECT(IELEM)
  110. CALL RPELEM(NUELEM,RPMAT,
  111. $ NOSOMA,NUELMA,
  112. $ IMPR,IRET)
  113. IF (IRET.NE.0) GOTO 9999
  114. NOSOMA=MAX(1,NOSOMA)
  115. SIMAT=IMAT.LIZAFM(NOSOMA,IBME)
  116. NPP=SIMAT.AM(/2)
  117. NPD=SIMAT.AM(/3)
  118. DO 522 IPD=1,NPD
  119. DO 5222 IPP=1,NPP
  120. IVMATR=IVMATR+1
  121. SLMATR.XVAL(IVMATR)=SIMAT.AM(NUELMA,IPP,IPD)
  122. 5222 CONTINUE
  123. 522 CONTINUE
  124. SLMATR.IDXX(IELEM+1)=SLMAT1.IDXX(IELEM+1)
  125. 52 CONTINUE
  126. SEGDES SLMATR
  127. *
  128. * Bug !
  129. *
  130. * LMATR.LISLI(IBME)=SLMATR
  131. LMATR.LISLI(INBME)=SLMATR
  132. 5 CONTINUE
  133. SEGSUP SLMAT1
  134. SEGDES LELEM
  135. SEGSUP RPMAT
  136. SEGDES LMATR
  137. SEGDES LNBME
  138. CALL DESIMA(IMAT)
  139. *
  140. * Normal termination
  141. *
  142. IRET=0
  143. RETURN
  144. *
  145. * Format handling
  146. *
  147. *
  148. * Error handling
  149. *
  150. 9999 CONTINUE
  151. IRET=1
  152. WRITE(IOIMP,*) 'An error was detected in subroutine exmali'
  153. RETURN
  154. *
  155. * End of subroutine EXMALI
  156. *
  157. END
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  

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