Sources Esope | Cast3M

graco12
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