Télécharger la plaquette Cast3M


fr en

Télécharger lump3.eso

Retour à la liste

Numérotation des lignes : 

lump3

  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
  29.       CALL ZERO(REWOLP,18,18)
  30. c      on traite ux uy uz
  31. c       boucle sur les noeuds
  32.       DO 430 I=1,3
  33. c         boucle sur les ddl ux uy uz locaux
  34.           DO 420 J=1,3
  35.               IDERIJ = 6*(I-1) + J
  36.               SUM = 0.D0
  37.               DO 410 K=1,3
  38.                   DO 400 L=1,3
  39.                       IDERKL= 6*(K-1)+L
  40.                       SUM = SUM + REWO(IDERIJ,IDERKL)
  41.  400              CONTINUE
  42.  410          CONTINUE
  43.               REWOLP(IDERIJ,IDERIJ) = SUM
  44.  420      CONTINUE
  45.  430  CONTINUE
  46. c
  47. c        on traite maintenant rx ry rz
  48. c
  49.       TRAC = 0.D0
  50.       DO 440 I =4,16,6
  51.           TRAC = TRAC + REWO(I,I)+ REWO(I+1,I+1)
  52.  440  CONTINUE
  53.       DO 460 I=3,15,6
  54.           DO 450 J=1,3
  55.               REWOLP(I+J,I+J) = TRAC / 9.D0
  56.  450      CONTINUE
  57.  460  CONTINUE
  58. c
  59. c        substitution
  60. c
  61.       DO 480 I=1,18
  62.           DO 470 J=1,18
  63.               REWO(I,J)=REWOLP(I,J)
  64.  470      CONTINUE
  65.  480  CONTINUE
  66.       RETURN
  67.       END
  68. c
  69.  
  70.  
  71.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales