C GRACO12 SOURCE PV090527 23/12/20 21:15:06 11813 SUBROUTINE GRACO12( ICHOLX, ILICR1,ilicr2) * * Conversion de la matrice factorisee en stockage creux ligne * Ensuite construction du stockage ligne de la transposee * * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMMATRI -INC SMRIGID segment ilicre * stockage matrice fatorise en creux * ilideb position debut de ligne dans ligcre integer ilideb(nbinc+1) integer ligcrp endsegment segment ligcre * lmatr: longueur reelle ligne * posm: numero inconnue * valm: valeur terme integer posm(lmat) real*8 valm(lmat) endsegment pointeur ilicr1.ilicre,ligcr1.ligcre MMATRI=ICHOLX * activation de la matrice une fois pour toute. MILIGN=IILIGN SEGACT,MILIGN INO=ILIGN(/1) * nombre inconnues nbinc=0 DO I=1,INO LIGN=ILIGN(I) SEGACT LIGN nbinc=nbinc+immm(/1) enddo segini ilicre * longueur chaque ligne do i=1,ino lign=ilign(i) do jpa=1,immm(/1) ilideb(iprel+jpa-1)=ivpo(2*ippvv(jpa+1))-ivpo(2*ippvv(jpa)) enddo enddo * taille totale de la matrice lmat=0 do i=2,nbinc+1 ilideb(i)=ilideb(i)+ilideb(i-1) enddo lmat=ilideb(nbinc+1) * ilideb pointe vers la fin de chaque ligne do i=nbinc+1,2,-1 ilideb(i)=ilideb(i-1) enddo ilideb(1)=0 * ilideb pointe maintenant vers la fin de la ligne precedente ** write (6,*) ' nb inconnues ',nbinc,'taille matrice ',lmat segini ligcre ligcrp=ligcre do i=1,ino lign=ilign(i) do jpa=1,immm(/1) incb=iprel+jpa-1 igf=ippvv(jpa+1)-1 ildebf=ivpo(2*igf) ilfinf=ivpo(2*(igf+1))-1 idebf=ivpo(2*igf-1) ifinf=idebf+ilfinf-ildebf do ig=ippvv(jpa),ippvv(jpa+1)-1 ildeb=ivpo(2*ig) ilfin=ivpo(2*(ig+1))-1 ideb=ivpo(2*ig-1) ifin=ideb+ilfin-ildeb ** write (6,*) ' incb ilideb ',incb,ilideb(incb),ildeb,ilfin do mpa=ildeb,ilfin ilideb(incb)=ilideb(incb)+1 valm(ilideb(incb))=val(mpa) posm(ilideb(incb))=mpa-ildeb+ideb + incb-ifinf enddo enddo ** write (6,*) 'graco12 dernier incb et derniere valeurs ', ** > incb,ilideb(incb),posm(ilideb(incb)),i,jpa enddo segdes lign enddo * repasser ilideb vers les debuts de ligne do i=nbinc+1,2,-1 ilideb(i)=ilideb(i-1)+1 enddo ilideb(1)=1 ** write (6,*) ' structure de la matrice ', ** > (valm(i),posm(i),i=1,lmat) * matrice remplie ilideb pointe vers les fins de ligne * ilicr1=ilicre ligcr1=ligcre * * construction de la transposee segini ilicre ilicr2=ilicre segini ligcre ligcrp=ligcre * * calcul nb termes par ligne * do i=1,nbinc do j=ilicr1.ilideb(i),ilicr1.ilideb(i+1)-1 inc=ligcr1.posm(j) ilideb(inc)=ilideb(inc)+1 enddo enddo do i=2,nbinc+1 ilideb(i)=ilideb(i)+ilideb(i-1) enddo lmat=ilideb(nbinc+1) * ilideb pointe vers la fin de chaque ligne do i=nbinc+1,2,-1 ilideb(i)=ilideb(i-1) enddo ilideb(1)=0 * ilideb pointe maintenant vers la fin de la ligne precedente do i=1,nbinc do j=ilicr1.ilideb(i),ilicr1.ilideb(i+1)-1 inc=ligcr1.posm(j) ilideb(inc)=ilideb(inc)+1 valm(ilideb(inc))=ligcr1.valm(j) posm(ilideb(inc))=i enddo enddo * repasser ilideb vers les debuts de ligne do i=nbinc+1,2,-1 ilideb(i)=ilideb(i-1)+1 enddo ilideb(1)=1 end