Sources Esope | Cast3M

graco11
C GRACO11   SOURCE    PV090527  26/02/20    21:15:01     12479          
      SUBROUTINE GRACO11( ICHOLX,ilicre, iappel)
*
*     Conversion de la matrice assemblee en stockage creux ligne
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRI
-INC SMRIGID
-INC SILICRE
      ligcre=0
      ilicre=0
      MMATRI=ICHOLX
*  activation de la matrice une fois pour toute.
      SEGACT,MMATRI*mod
      MILIGN=IASLIG
      if(iappel.eq.1) milign=iilign
      SEGACT,MILIGN
      INO=ILIGN(/1)
      MDNOR=IDNORM
      SEGACT MDNOR
* nombre inconnues
      nbinc=0
      DO  I=1,INO
       LLIGN=ILIGN(I)
       SEGACT LLIGN
       nbinc=nbinc+immmm(/1)
      enddo
      segini/err=1000/ilicre
* longueur chaque ligne
**    iliinc(1)=0
      do i=1,ino
       llign=ilign(i)
**     iliinc(i+1)=immmm(immmm(/1))
       do jpa=1,immmm(/1)
* ipp fin ligne precedente kpa  longueur ligne
        ipp=ippo(jpa)
        kpa=ippo(jpa+1)-ipp
        ilideb(immmm(jpa))=kpa
* mise a jour des longueurs partie transposee
        do mpa=ipp+1,ippo(jpa+1)
           if (linc(mpa).ne.immmm(jpa))
     >       ilideb(linc(mpa))=ilideb(linc(mpa))+1
        enddo
       enddo
       SEGDES LLIGN
      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/err=1100/ligcre
      ligcrp=ligcre
      do i=1,ino
       llign=ilign(i)
       segact llign
       do jpa=1,immmm(/1)
        ipp=ippo(jpa)
        incb=immmm(jpa)
        do mpa=ipp+1,ippo(jpa+1)
         ilideb(incb)=ilideb(incb)+1
         valm(ilideb(incb))=xxva(mpa)
         posm(ilideb(incb))=linc(mpa)
        enddo
* remplissage partie transposee
        do mpa=ipp+1,ippo(jpa+1)
         inc=linc(mpa)
         if (inc.ne.incb) then
          ilideb(inc)=ilideb(inc)+1
          valm(ilideb(inc))=xxva(mpa)
          posm(ilideb(inc))=immmm(jpa)
         endif
        enddo
       enddo
       segdes llign
      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
*
      if(iappel.eq.1) segdes ilicre,ligcre,mdnor
      jlicre=ilicre
      return
 1100 continue
*     segini ligcre echoue
      if(ilicre.ne.0) segsup ilicre
 1000 continue
*  segini ilicre echoue
      DO  I=1,INO
       LLIGN=ILIGN(I)
       SEGDES LLIGN
      enddo
      segdes milign
      segdes mdnor
      jlicre=ilicre
      return
      end