Télécharger proli2.eso

Retour à la liste

Numérotation des lignes :

  1. C PROLI2 SOURCE CHAT 05/01/13 02:32:40 5004
  2. SUBROUTINE PROLI2(LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  3. $ LILBLC,KRMPRI,KMDCDB,KMPRBP,
  4. $ SLCHPD,SLMATB,SLMATC,
  5. $ LMPCDB,LMDCDB,NELCDB,
  6. $ SLMCDB,
  7. $ IMPR,IRET)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Z)
  10. C***********************************************************************
  11. C NOM : PROLI2
  12. C DESCRIPTION : Produit des matrices stockées sous forme de listes
  13. C indexées (2 : Boucles sur les éléments)
  14. C
  15. C
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES : -
  22. C APPELE PAR : PROLIS
  23. C***********************************************************************
  24. C ENTREES : tout sauf SLMCDB
  25. C SORTIES : SLMCDB
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 14/02/2000, version initiale
  29. C HISTORIQUE : v1, 14/02/2000, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. -INC SMLENTI
  39. POINTEUR KRMPRI.MLENTI
  40. POINTEUR KMPRBP.MLENTI
  41. POINTEUR KMDCDB.MLENTI
  42. * Includes persos
  43. * Segment LSTIND (liste séquentielle indexée)
  44. SEGMENT LSTIND
  45. INTEGER IDX(NBM+1)
  46. INTEGER IVAL(NBTVAL)
  47. ENDSEGMENT
  48. POINTEUR LMDUAB.LSTIND
  49. POINTEUR LMPRIB.LSTIND
  50. POINTEUR LMPRIC.LSTIND
  51. POINTEUR LMDUAC.LSTIND
  52. POINTEUR LILBLC.LSTIND
  53. POINTEUR LMPCDB.LSTIND
  54. POINTEUR LMDCDB.LSTIND
  55. SEGMENT LSRIND
  56. INTEGER IDXX(NBM+1)
  57. REAL*8 XVAL(NBTVAL)
  58. ENDSEGMENT
  59. POINTEUR SLMATB.LSRIND
  60. POINTEUR SLMATC.LSRIND
  61. POINTEUR SLMCDB.LSRIND
  62. -INC SMLREEL
  63. POINTEUR SLCHPD.MLREEL
  64. *
  65. INTEGER NELCDB
  66. INTEGER IMPR,IRET
  67. *
  68. INTEGER IELCDB
  69. INTEGER KVDCDB,KVSTRT,KVSTOP,IPDCDB
  70. INTEGER LVMPBP,LVSTRT,LVSTOP
  71. INTEGER MVLBLC,MVSTRT,MVSTOP
  72. INTEGER NVPRIC,NVSTRT,NVSTOP
  73. INTEGER OVDUAC,OVSTRT,OVSTOP
  74. INTEGER PVDUAB,PVSTRT,PVSTOP
  75. INTEGER QVMATC,QVSTRT
  76. INTEGER RVMATB,RVSTRT
  77. INTEGER SVMCDB,SVSTRT
  78. INTEGER NPPB,NPPC,NPPCDB
  79. INTEGER NLOCPB,NUELC,NUMPC,NUPBP,NUPDP
  80. REAL*8 BIJ,CIK,COEFD
  81. *
  82. * Executable statements
  83. *
  84. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans proli2.eso'
  85. *
  86. * Boucle sur les éléments de CD-1Bt
  87. *
  88. *COMM SEGPRT,LMDCDB
  89. DO 1 IELCDB=1,NELCDB
  90. * On construit KRDCDB
  91. KVSTRT=LMDCDB.IDX(IELCDB)
  92. KVSTOP=LMDCDB.IDX(IELCDB+1)-1
  93. DO 11 KVDCDB=KVSTRT,KVSTOP
  94. NUPDP=LMDCDB.IVAL(KVDCDB)
  95. KMDCDB.LECT(NUPDP)=KVDCDB-KVSTRT
  96. 11 CONTINUE
  97. *COMM WRITE(IOIMP,*) 'Repérage dans LMDCDB'
  98. *COMM SEGPRT,KMDCDB
  99. * On construit KRMPBP
  100. LVSTRT=LMPRIB.IDX(IELCDB)
  101. LVSTOP=LMPRIB.IDX(IELCDB+1)-1
  102. DO 12 LVMPBP=LVSTRT,LVSTOP
  103. NUPBP=LMPRIB.IVAL(LVMPBP)
  104. IF (KRMPRI.LECT(NUPBP).NE.0) THEN
  105. KMPRBP.LECT(NUPBP)=LVMPBP-LVSTRT+1
  106. ENDIF
  107. 12 CONTINUE
  108. *COMM WRITE(IOIMP,*) 'Repérage dans LMPRIB'
  109. *COMM SEGPRT,KMPRBP
  110. *COMM WRITE(IOIMP,*) 'Numéro d''élément de CD-1Bt (ouB)=',IELCDB
  111. NPPCDB=LMPCDB.IDX(IELCDB+1)-LMPCDB.IDX(IELCDB)
  112. NPPB =LMPRIB.IDX(IELCDB+1)-LMPRIB.IDX(IELCDB)
  113. RVSTRT=SLMATB.IDXX(IELCDB)
  114. SVSTRT=SLMCDB.IDXX(IELCDB)
  115. * On parcourt les éléments de la matrice C de ayant au moins un point
  116. * commmun avec un élément de la matrice B courante
  117. MVSTRT=LILBLC.IDX(IELCDB)
  118. MVSTOP=LILBLC.IDX(IELCDB+1)-1
  119. DO 13 MVLBLC=MVSTRT,MVSTOP
  120. NUELC=LILBLC.IVAL(MVLBLC)
  121. *COMM WRITE(IOIMP,*) ' Numéro d''élément C',NUELC
  122. NPPC=LMPRIC.IDX(NUELC+1)-LMPRIC.IDX(NUELC)
  123. QVSTRT=SLMATC.IDXX(NUELC)
  124. * Parcourons les points de l'élément NUELC de MPRIC
  125. NVSTRT=LMPRIC.IDX(NUELC)
  126. NVSTOP=LMPRIC.IDX(NUELC+1)-1
  127. DO 132 NVPRIC=NVSTRT,NVSTOP
  128. NUMPC=LMPRIC.IVAL(NVPRIC)
  129. *COMM WRITE(IOIMP,*) ' Point du primal de C :',NUMPC
  130. NLOCPB=KMPRBP.LECT(NUMPC)
  131. *COMM WRITE(IOIMP,*) ' NLOCPB=',NLOCPB
  132. IF (NLOCPB.NE.0) THEN
  133. * On a trouvé un point de MPRIB qui correspond donc
  134. * on parcourt les points de l'élément NUELC de MDUAC
  135. * et les points de l'élément IELCDB de MDUAB
  136. OVSTRT=LMDUAC.IDX(NUELC)
  137. OVSTOP=LMDUAC.IDX(NUELC+1)-1
  138. PVSTRT=LMDUAB.IDX(IELCDB)
  139. PVSTOP=LMDUAB.IDX(IELCDB+1)-1
  140. IF (SLCHPD.NE.0) THEN
  141. COEFD=SLCHPD.PROG(KRMPRI.LECT(NUMPC))
  142. *COMM WRITE(IOIMP,*) ' COEFD=',COEFD
  143. ENDIF
  144. DO 1322 OVDUAC=OVSTRT,OVSTOP
  145. *COMM write(ioimp,*) ' po. dua. C=',
  146. *COMM $ LMDUAC.IVAL(OVDUAC)
  147. QVMATC=QVSTRT+
  148. $ (NPPC*(OVDUAC-OVSTRT)+(NVPRIC-NVSTRT))
  149. CIK=SLMATC.XVAL(QVMATC)
  150. *COMM WRITE(IOIMP,*) ' CIK=',CIK
  151. IPDCDB=KMDCDB.LECT(LMDUAC.IVAL(OVDUAC))
  152. DO 13222 PVDUAB=PVSTRT,PVSTOP
  153. *COMM write(ioimp,*) ' po. dua. B=',
  154. *COMM $ LMDUAB.IVAL(PVDUAB)
  155. RVMATB=RVSTRT+
  156. $ (NPPB*(PVDUAB-PVSTRT)+(NLOCPB-1))
  157. BIJ=SLMATB.XVAL(RVMATB)
  158. *COMM WRITE(IOIMP,*) ' BIJ=',BIJ
  159. SVMCDB=SVSTRT+
  160. $ (IPDCDB*NPPCDB+(PVDUAB-PVSTRT))
  161. *COMM WRITE(IOIMP,*) ' SVMCDB=',SVMCDB
  162. IF (SLCHPD.NE.0) THEN
  163. SLMCDB.XVAL(SVMCDB)=SLMCDB.XVAL(SVMCDB)
  164. $ +(BIJ*COEFD*CIK)
  165. ELSE
  166. SLMCDB.XVAL(SVMCDB)=SLMCDB.XVAL(SVMCDB)
  167. $ +(BIJ*CIK)
  168. ENDIF
  169. 13222 CONTINUE
  170. 1322 CONTINUE
  171. ENDIF
  172. 132 CONTINUE
  173. 13 CONTINUE
  174. * On remet KRMPBP à 0
  175. DO 15 LVMPBP=LVSTRT,LVSTOP
  176. NUPBP=LMPRIB.IVAL(LVMPBP)
  177. IF (KRMPRI.LECT(NUPBP).NE.0) THEN
  178. KMPRBP.LECT(NUPBP)=0
  179. ENDIF
  180. 15 CONTINUE
  181. * On remet KRDCDB à 0
  182. DO 17 KVDCDB=KVSTRT,KVSTOP
  183. NUPDP=LMDCDB.IVAL(IELCDB)
  184. KMDCDB.LECT(NUPDP)=0
  185. 17 CONTINUE
  186. 1 CONTINUE
  187.  
  188. *
  189. * Normal termination
  190. *
  191. IRET=0
  192. RETURN
  193. *
  194. * Format handling
  195. *
  196. *
  197. * Error handling
  198. *
  199. 9999 CONTINUE
  200. IRET=1
  201. WRITE(IOIMP,*) 'An error was detected in subroutine proli2'
  202. RETURN
  203. *
  204. * End of subroutine PROLI2
  205. *
  206. END
  207.  
  208.  
  209.  
  210.  
  211.  

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