Télécharger joiglo.eso

Retour à la liste

Numérotation des lignes :

  1. C JOIGLO SOURCE AM 11/05/03 21:17:15 6955
  2. SUBROUTINE JOIGLO(REL,BPSS,P,PT,REG,REH,LRE,IDIM)
  3. C-----------------------------------------------------------------------
  4. C CALCUL D'UNE MATRICE DANS LE REPERE GLOBAL
  5. C
  6. C ENTREE
  7. C REL MATRICE EXPRIMEE DANS LE REPERE LOCAL
  8. C BPSS MATRICE DE PASSAGE
  9. C SORTIE
  10. C REL MATRICE EXPRIMEE DANS LE REPERE GLOBAL
  11. C-----------------------------------------------------------------------
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. DIMENSION BPSS(3,3),P(LRE,LRE),Pt(LRE,LRE)
  15. DIMENSION REL(LRE,LRE),REG(LRE,LRE),REH(LRE,LRE)
  16. CALL ZERO(REG,LRE,LRE)
  17. CALL ZERO(REH,LRE,LRE)
  18. CALL ZERO(P,LRE,LRE)
  19. CALL ZERO(Pt,LRE,LRE)
  20. *
  21. * ASSEMBLAGE DE PASSAGE P
  22. *
  23. IF(IDIM.EQ.3) THEN
  24. DO K=0,3
  25. DO I=1,3
  26. DO J=1,3
  27. P(I+3*K,J+3*K)=BPSS(I,J)
  28. ENDDO
  29. ENDDO
  30. ENDDO
  31. ELSE IF(IDIM.EQ.2) THEN
  32. DO K=0,1
  33. DO I=1,3
  34. DO J=1,3
  35. P(I+3*K,J+3*K)=BPSS(I,J)
  36. ENDDO
  37. ENDDO
  38. ENDDO
  39. ENDIF
  40. C
  41. C Creation de la transposée de P
  42. C
  43. DO I=1,LRE
  44. DO J=1,LRE
  45. Pt(J,I)=P(I,J)
  46. ENDDO
  47. ENDDO
  48. C
  49. C REG = REL*P
  50. C
  51. DO I=1,LRE
  52. DO J=1,LRE
  53. DO K=1,LRE
  54. REG(I,J) = REG(I,J) + REL(I,K)*P(K,J)
  55. ENDDO
  56. ENDDO
  57. ENDDO
  58. C
  59. C REH = Pt*REG
  60. C
  61. DO I=1,LRE
  62. DO J=1,LRE
  63. DO K=1,LRE
  64. REH(I,J) = REH(I,J) + Pt(I,K)*REG(K,J)
  65. ENDDO
  66. ENDDO
  67. ENDDO
  68. *
  69. CALL ZERO(REL,LRE,LRE)
  70. C
  71. C REL = REG
  72. C
  73. DO I=1,LRE
  74. DO J=1,LRE
  75. REL(I,J)=REH(I,J)
  76. ENDDO
  77. ENDDO
  78. *
  79. RETURN
  80. END
  81.  
  82.  
  83.  
  84.  

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