C LUMP4     SOURCE    CHAT      05/01/13    01:27:07     5004
      SUBROUTINE  LUMP4(REWO)
c---------------------------------------------------------------------
c
c    diagonalisation dans le cas de l'opérateur lump
c    coq4
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(24,*)
      DIMENSION REWOLP(24,24)
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,24,24)
c      on traite ux uy uz
c       boucle sur les noeuds
      DO 430 I=1,4
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,4
                  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,22,6
        DO 435 J=4,22,6
          TRAC=TRAC+REWO(I,J)+REWO(I,J+1)+REWO(I+1,J)
     &         +REWO(I+1,J+1)
 435    CONTINUE
 440  CONTINUE
      DO 460 I=3,21,6
          DO 450 J=1,3
              REWOLP(I+J,I+J) = TRAC / 12.D0
 450      CONTINUE
 460  CONTINUE
c
c        substitution
c
      DO 480 I=1,24
          DO 470 J=1,24
              REWO(I,J)=REWOLP(I,J)
 470      CONTINUE
 480  CONTINUE
      RETURN
      END
c