C LUMP3     SOURCE    CHAT      05/01/13    01:27:02     5004
      SUBROUTINE  LUMP3(REWO)
c---------------------------------------------------------------------
c
c    diagonalisation dans le cas de l'opérateur lump
c     coq3 et dkt
c
c  entree
c      rewo est rangé dans l'ordre i noeud x(ux uy uz rx ry rz) ....
c  sortie
c      rewo diagonalisé
c
c  intermédiaire
c      rewolp  est rangé dans le meme ordre mais est diagonale
c
c
c
c---------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION REWO(18,*)
      DIMENSION REWOLP(18,18)
c
c    diagonalisation dans le cas de l'opérateur lump
c
c      rewo est rangé dans l'ordre i noeud x(ux uy uz rx ry rz) ....
c
c
      CALL ZERO(REWOLP,18,18)
c      on traite ux uy uz
c       boucle sur les noeuds
      DO 430 I=1,3
c         boucle sur les ddl ux uy uz locaux
          DO 420 J=1,3
              IDERIJ = 6*(I-1) + J
              SUM = 0.D0
              DO 410 K=1,3
                  DO 400 L=1,3
                      IDERKL= 6*(K-1)+L
                      SUM = SUM + REWO(IDERIJ,IDERKL)
 400              CONTINUE
 410          CONTINUE
              REWOLP(IDERIJ,IDERIJ) = SUM
 420      CONTINUE
 430  CONTINUE
c
c        on traite maintenant rx ry rz
c
      TRAC = 0.D0
      DO 440 I =4,16,6
          TRAC = TRAC + REWO(I,I)+ REWO(I+1,I+1)
 440  CONTINUE
      DO 460 I=3,15,6
          DO 450 J=1,3
              REWOLP(I+J,I+J) = TRAC / 9.D0
 450      CONTINUE
 460  CONTINUE
c
c        substitution
c
      DO 480 I=1,18
          DO 470 J=1,18
              REWO(I,J)=REWOLP(I,J)
 470      CONTINUE
 480  CONTINUE
      RETURN
      END
c