Esope source files

   1 : C LUMP3     SOURCE    CHAT      05/01/13    01:27:02     5004           
   2 :       SUBROUTINE  LUMP3(REWO)
   3 : c---------------------------------------------------------------------
   4 : c
   5 : c    diagonalisation dans le cas de l'opérateur lump
   6 : c     coq3 et dkt
   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(18,*)
  22 :       DIMENSION REWOLP(18,18)
  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,18,18)
  29 : c      on traite ux uy uz
  30 : c       boucle sur les noeuds
  31 :       DO 430 I=1,3
  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,3
  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,16,6
  50 :           TRAC = TRAC + REWO(I,I)+ REWO(I+1,I+1)
  51 :  440  CONTINUE
  52 :       DO 460 I=3,15,6
  53 :           DO 450 J=1,3
  54 :               REWOLP(I+J,I+J) = TRAC / 9.D0
  55 :  450      CONTINUE
  56 :  460  CONTINUE
  57 : c
  58 : c        substitution
  59 : c
  60 :       DO 480 I=1,18
  61 :           DO 470 J=1,18
  62 :               REWO(I,J)=REWOLP(I,J)
  63 :  470      CONTINUE
  64 :  480  CONTINUE
  65 :       RETURN
  66 :       END
  67 : c
  68 :  
  69 :