Télécharger la plaquette Cast3M


fr en

Télécharger lump4.eso

Retour à la liste

Numérotation des lignes : 

lump4

  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
  29.       CALL ZERO(REWOLP,24,24)
  30. c      on traite ux uy uz
  31. c       boucle sur les noeuds
  32.       DO 430 I=1,4
  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,4
  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,22,6
  51.         DO 435 J=4,22,6
  52.           TRAC=TRAC+REWO(I,J)+REWO(I,J+1)+REWO(I+1,J)
  53.      &         +REWO(I+1,J+1)
  54.  435    CONTINUE
  55.  440  CONTINUE
  56.       DO 460 I=3,21,6
  57.           DO 450 J=1,3
  58.               REWOLP(I+J,I+J) = TRAC / 12.D0
  59.  450      CONTINUE
  60.  460  CONTINUE
  61. c
  62. c        substitution
  63. c
  64.       DO 480 I=1,24
  65.           DO 470 J=1,24
  66.               REWO(I,J)=REWOLP(I,J)
  67.  470      CONTINUE
  68.  480  CONTINUE
  69.       RETURN
  70.       END
  71. c
  72.  
  73.  
  74.  

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