Télécharger lump4.eso

Retour à la liste

Numérotation des lignes :

  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