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