Télécharger graco11.eso

Retour à la liste

Numérotation des lignes :

  1. C GRACO11 SOURCE PV 16/11/17 21:59:34 9180
  2. SUBROUTINE GRACO11( ICHOLX, ILICRE)
  3. *
  4. * Conversion de la matrice assemblee en stockage creux ligne
  5. *
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. -INC CCOPTIO
  9. -INC SMMATRI
  10. -INC SMRIGID
  11. segment ilicre
  12. * stockage matrice initiale en creux
  13. * ilideb position debut de ligne dans ligcre
  14. * iliinc derniere inconnue par noeud
  15. integer ilideb(nbinc+1)
  16. ** integer iliinc(ino+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. MMATRI=ICHOLX
  27. * activation de la matrice une fois pour toute.
  28. SEGACT,MMATRI
  29. MILIGN=IASLIG
  30. SEGACT,MILIGN
  31. INO=ILIGN(/1)
  32. MDNOR=IDNORM
  33. SEGACT MDNOR
  34. * nombre inconnues
  35. DO I=1,INO
  36. LLIGN=ILIGN(I)
  37. SEGACT LLIGN
  38. nbinc=nbinc+immmm(/1)
  39. enddo
  40. segini ilicre
  41. * longueur chaque ligne
  42. ** iliinc(1)=0
  43. do i=1,ino
  44. llign=ilign(i)
  45. ** iliinc(i+1)=immmm(immmm(/1))
  46. do jpa=1,immmm(/1)
  47. * ipp fin ligne precedente kpa longueur ligne
  48. ipp=ippo(jpa)
  49. kpa=ippo(jpa+1)-ipp
  50. ilideb(immmm(jpa))=kpa
  51. * mise a jour des longueurs partie transposee
  52. do mpa=ipp+1,ippo(jpa+1)
  53. if (linc(mpa).ne.immmm(jpa))
  54. > ilideb(linc(mpa))=ilideb(linc(mpa))+1
  55. enddo
  56. enddo
  57. enddo
  58. * taille totale de la matrice
  59. lmat=0
  60. do i=2,nbinc+1
  61. ilideb(i)=ilideb(i)+ilideb(i-1)
  62. enddo
  63. lmat=ilideb(nbinc+1)
  64. * ilideb pointe vers la fin de chaque ligne
  65. do i=nbinc+1,2,-1
  66. ilideb(i)=ilideb(i-1)
  67. enddo
  68. ilideb(1)=0
  69. * ilideb pointe maintenant vers la fin de la ligne precedente
  70. * write (6,*) ' nb inconnues ',nbinc,'taille matrice ',lmat
  71. segini ligcre
  72. ligcrp=ligcre
  73. do i=1,ino
  74. llign=ilign(i)
  75. do jpa=1,immmm(/1)
  76. ipp=ippo(jpa)
  77. incb=immmm(jpa)
  78. do mpa=ipp+1,ippo(jpa+1)
  79. ilideb(incb)=ilideb(incb)+1
  80. valm(ilideb(incb))=xxva(mpa)
  81. posm(ilideb(incb))=linc(mpa)
  82. enddo
  83. * remplissage partie transposee
  84. do mpa=ipp+1,ippo(jpa+1)
  85. inc=linc(mpa)
  86. if (inc.ne.incb) then
  87. ilideb(inc)=ilideb(inc)+1
  88. valm(ilideb(inc))=xxva(mpa)
  89. posm(ilideb(inc))=immmm(jpa)
  90. endif
  91. enddo
  92. enddo
  93. enddo
  94. * repasser ilideb vers les debuts de ligne
  95. do i=nbinc+1,2,-1
  96. ilideb(i)=ilideb(i-1)+1
  97. enddo
  98. ilideb(1)=1
  99. ** write (6,*) ' structure de la matrice ',
  100. ** > (valm(i),posm(i),i=1,lmat)
  101. * matrice remplie ilideb pointe vers les fins de ligne
  102. *
  103.  
  104. end
  105.  
  106.  
  107.  
  108.  

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