Esope source files

   1 : C LUMP4     SOURCE    CHAT      05/01/13    01:27:07     5004           
   2 :       SUBROUTINE  LUMP4(REWO)
   3 : c---------------------------------------------------------------------
   4 : c
   5 : c    diagonalisation dans le cas de l'opérateur lump
   6 : c    coq4
   7 : c
   8 : c  entree
   9 : c      rewo est rangé dans l'ordre i noeud x(ux uy uz rx ry rz) ....
  10 : c  sortie
  11 : c      rewo diagonalisé
  12 : c
  13 : c  intermédiaire
  14 : c      rewolp  est rangé dans le meme ordre mais est diagonale
  15 : c
  16 : c  
  17 : c
  18 : c---------------------------------------------------------------------
  19 :       IMPLICIT INTEGER(I-N)
  20 :       IMPLICIT REAL*8(A-H,O-Z)
  21 :       DIMENSION REWO(24,*)
  22 :       DIMENSION REWOLP(24,24)
  23 : c
  24 : c    diagonalisation dans le cas de l'opérateur lump
  25 : c
  26 : c      rewo est rangé dans l'ordre i noeud x(ux uy uz rx ry rz) ....
  27 : c
  28 : c
  28 :       CALL ZERO(REWOLP,24,24)
  29 : c      on traite ux uy uz
  30 : c       boucle sur les noeuds
  31 :       DO 430 I=1,4
  32 : c         boucle sur les ddl ux uy uz locaux
  33 :           DO 420 J=1,3
  34 :               IDERIJ = 6*(I-1) + J
  35 :               SUM = 0.D0
  36 :               DO 410 K=1,4
  37 :                   DO 400 L=1,3
  38 :                       IDERKL= 6*(K-1)+L
  39 :                       SUM = SUM + REWO(IDERIJ,IDERKL)
  40 :  400              CONTINUE
  41 :  410          CONTINUE
  42 :               REWOLP(IDERIJ,IDERIJ) = SUM
  43 :  420      CONTINUE
  44 :  430  CONTINUE
  45 : c
  46 : c        on traite maintenant rx ry rz
  47 : c
  48 :       TRAC = 0.D0
  49 :       DO 440 I =4,22,6
  50 :         DO 435 J=4,22,6
  51 :           TRAC=TRAC+REWO(I,J)+REWO(I,J+1)+REWO(I+1,J)
  52 :      &         +REWO(I+1,J+1)
  53 :  435    CONTINUE
  54 :  440  CONTINUE
  55 :       DO 460 I=3,21,6
  56 :           DO 450 J=1,3
  57 :               REWOLP(I+J,I+J) = TRAC / 12.D0
  58 :  450      CONTINUE
  59 :  460  CONTINUE
  60 : c
  61 : c        substitution
  62 : c
  63 :       DO 480 I=1,24
  64 :           DO 470 J=1,24
  65 :               REWO(I,J)=REWOLP(I,J)
  66 :  470      CONTINUE
  67 :  480  CONTINUE
  68 :       RETURN
  69 :       END
  70 : c
  71 :  
  72 :