Télécharger graco12.eso

Retour à la liste

Numérotation des lignes :

  1. C GRACO12 SOURCE PV 16/11/17 21:59:34 9180
  2. SUBROUTINE GRACO12( ICHOLX, ILICR1,ilicr2)
  3. *
  4. * Conversion de la matrice factorisee en stockage creux ligne
  5. * Ensuite construction du stockage ligne de la transposee
  6. *
  7. *
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. -INC CCOPTIO
  11. -INC SMMATRI
  12. -INC SMRIGID
  13. segment ilicre
  14. * stockage matrice fatorise en creux
  15. * ilideb position debut de ligne dans ligcre
  16. integer ilideb(nbinc+1)
  17. integer ligcrp
  18. endsegment
  19. segment ligcre
  20. * lmatr: longueur reelle ligne
  21. * posm: numero inconnue
  22. * valm: valeur terme
  23. integer posm(lmat)
  24. real*8 valm(lmat)
  25. endsegment
  26. pointeur ilicr1.ilicre,ligcr1.ligcre
  27. MMATRI=ICHOLX
  28. * activation de la matrice une fois pour toute.
  29. SEGACT,MMATRI
  30. MILIGN=IILIGN
  31. SEGACT,MILIGN
  32. INO=ILIGN(/1)
  33. * nombre inconnues
  34. DO I=1,INO
  35. LIGN=ILIGN(I)
  36. SEGACT LIGN
  37. nbinc=nbinc+immm(/1)
  38. enddo
  39. segini ilicre
  40. * longueur chaque ligne
  41. do i=1,ino
  42. lign=ilign(i)
  43. do jpa=1,immm(/1)
  44. ilideb(iprel+jpa-1)=ivpo(2*ippvv(jpa+1))-ivpo(2*ippvv(jpa))
  45. enddo
  46. enddo
  47. * taille totale de la matrice
  48. lmat=0
  49. do i=2,nbinc+1
  50. ilideb(i)=ilideb(i)+ilideb(i-1)
  51. enddo
  52. lmat=ilideb(nbinc+1)
  53. * ilideb pointe vers la fin de chaque ligne
  54. do i=nbinc+1,2,-1
  55. ilideb(i)=ilideb(i-1)
  56. enddo
  57. ilideb(1)=0
  58. * ilideb pointe maintenant vers la fin de la ligne precedente
  59. ** write (6,*) ' nb inconnues ',nbinc,'taille matrice ',lmat
  60. segini ligcre
  61. ligcrp=ligcre
  62. do i=1,ino
  63. lign=ilign(i)
  64. do jpa=1,immm(/1)
  65. incb=iprel+jpa-1
  66. igf=ippvv(jpa+1)-1
  67. ildebf=ivpo(2*igf)
  68. ilfinf=ivpo(2*(igf+1))-1
  69. idebf=ivpo(2*igf-1)
  70. ifinf=idebf+ilfinf-ildebf
  71. do ig=ippvv(jpa),ippvv(jpa+1)-1
  72. ildeb=ivpo(2*ig)
  73. ilfin=ivpo(2*(ig+1))-1
  74. ideb=ivpo(2*ig-1)
  75. ifin=ideb+ilfin-ildeb
  76. ** write (6,*) ' incb ilideb ',incb,ilideb(incb),ildeb,ilfin
  77. do mpa=ildeb,ilfin
  78. ilideb(incb)=ilideb(incb)+1
  79. valm(ilideb(incb))=val(mpa)
  80. posm(ilideb(incb))=mpa-ildeb+ideb + incb-ifinf
  81. enddo
  82. enddo
  83. ** write (6,*) 'graco12 dernier incb et derniere valeurs ',
  84. ** > incb,ilideb(incb),posm(ilideb(incb)),i,jpa
  85. enddo
  86. enddo
  87.  
  88.  
  89. * repasser ilideb vers les debuts de ligne
  90. do i=nbinc+1,2,-1
  91. ilideb(i)=ilideb(i-1)+1
  92. enddo
  93. ilideb(1)=1
  94. ** write (6,*) ' structure de la matrice ',
  95. ** > (valm(i),posm(i),i=1,lmat)
  96. * matrice remplie ilideb pointe vers les fins de ligne
  97. *
  98. ilicr1=ilicre
  99. ligcr1=ligcre
  100. *
  101. * construction de la transposee
  102. segini ilicre
  103. ilicr2=ilicre
  104. segini ligcre
  105. ligcrp=ligcre
  106. *
  107. * calcul nb termes par ligne
  108. *
  109. do i=1,nbinc
  110. do j=ilicr1.ilideb(i),ilicr1.ilideb(i+1)-1
  111. inc=ligcr1.posm(j)
  112. ilideb(inc)=ilideb(inc)+1
  113. enddo
  114. enddo
  115. do i=2,nbinc+1
  116. ilideb(i)=ilideb(i)+ilideb(i-1)
  117. enddo
  118. lmat=ilideb(nbinc+1)
  119. * ilideb pointe vers la fin de chaque ligne
  120. do i=nbinc+1,2,-1
  121. ilideb(i)=ilideb(i-1)
  122. enddo
  123. ilideb(1)=0
  124. * ilideb pointe maintenant vers la fin de la ligne precedente
  125.  
  126.  
  127.  
  128. do i=1,nbinc
  129. do j=ilicr1.ilideb(i),ilicr1.ilideb(i+1)-1
  130. inc=ligcr1.posm(j)
  131. ilideb(inc)=ilideb(inc)+1
  132. valm(ilideb(inc))=ligcr1.valm(j)
  133. posm(ilideb(inc))=i
  134. enddo
  135. enddo
  136. * repasser ilideb vers les debuts de ligne
  137. do i=nbinc+1,2,-1
  138. ilideb(i)=ilideb(i-1)+1
  139. enddo
  140. ilideb(1)=1
  141.  
  142. end
  143.  
  144.  
  145.  
  146.  

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