Sources Esope | Cast3M

C MONDE1    SOURCE    PV        17/11/21    21:15:12     9629           
      SUBROUTINE MONDE1 (IPPVV,VECTBB,VAL,IVPO,
     >                   NA,IPREL,MULRE,INC,IFIB,dnorm)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION VECTBB(*),VAL(*),IVPO(*),IPPVV(*)
 
*  nombres de groupes (incluant la diagonale)
      nbg=ippvv(2)-1
*  longueur de la premiere ligne
      lpl=ivpo(2*(nbg+1))-ivpo(2*1)
*  nb termes premiere ligne
      nval=ivpo(2*(nbg+1)-1)-ivpo(2*1-1)
*  la partie triangulaire = le dernier groupe
      do 200 k=0,(mulre-1)*inc,inc
      ig=nbg
      iprelk=iprel+k
      iposb=-nval+iprelk
      do 120 ilm=na,1,-1
          ii=iprel-1+ilm
          vkon=vectbb(ii+k)
          if (abs(vkon).lt.dnorm) goto 120
          ildeb=ivpo(2*ig)
          ilfin=ildeb+ilm-1
          ideb=ivpo(2*ig-1)
          ifin=ideb+ilfin-ildeb
*  dans le groupe
          jdec=-ideb+ildeb+lpl*(ilm-1)+((ilm-1)*(ilm-2))/2
          do 130 j=ifin-1,ideb,-1
           vectbb(iposb+j)=vectbb(iposb+j)-vkon*val(jdec+j)
 130      continue
 120  continue
*  les groupes (hors groupe diagonal)
**    jdecb = lpl*na+((na)*(na-1))/2
      ilfin=ivpo(2*1)-1
      do 10 ig=1,nbg-1
*       ildeb=ivpo(2*ig)
        ildeb=ilfin+1
        ilfin=ivpo(2*(ig+1))-1
        ideb=ivpo(2*ig-1)
        ifin=ilfin+ideb-ildeb
*  les lignes
*  dans le groupe
          jdec =      -(ideb-ildeb)
          do 30 j=ideb,ifin
           ipos=j-nval+iprel
           p1=vectbb(ipos+k)
           jpos=j+jdec
        do 20 ilm=1,na
          ii=iprelk-1+ilm
           p1=p1-vectbb(ii)*val(jpos)
          jpos=jpos+ilm-1+lpl
  20    continue
         vectbb(ipos+k)=p1
  30      continue
  10  continue
 200  continue
      return
      end