Télécharger effi2.eso

Retour à la liste

Numérotation des lignes :

  1. C EFFI2 SOURCE CHAT 05/01/12 23:28:26 5004
  2. SUBROUTINE EFFI2(VALCAR,TYVAL,NCA1,NCAR1,REL,LRE,IB,IGAU,XATEF1,
  3. &NSTEP,DREND,CELEM)
  4. ***************************************************************
  5. * calcule la matrice d efficacite directionnelle
  6. * puis transforme la matrice elementaire par blocs
  7. ***************************************************************
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. DIMENSION VALCAR(*),REL(LRE,LRE)
  11. CHARACTER*16 TYVAL(*)
  12. CHARACTER*8 CELEM
  13. dimension xatef1(3,3),xmat1(3,3),tq(3,3),xres(3,3)
  14. dimension xmat2(3,3), q(3,3),xmat3(3,3)
  15. logical drend
  16.  
  17. if (drend) goto 1000
  18. * matrice de rotation
  19. w1x = valcar(ncar1+1)
  20. w1y = valcar(ncar1+2)
  21. w1z = valcar(ncar1+3)
  22. w2x = valcar(ncar1+4)
  23. w2y = valcar(ncar1+5)
  24. w2z = valcar(ncar1+6)
  25. tq(1,1) = w1x
  26. tq(2,1) = w1y
  27. tq(1,2) = w2x
  28. tq(2,2) = w2y
  29. if (nstep.gt.2) then
  30. w3x = w1y*w2z - w1z*w2y
  31. w3y = w2x*w1z - w2z*w1x
  32. w3z = w1x*w2y - w1y*w2x
  33. tq(3,1) = w1z
  34. tq(3,2) = w2z
  35. tq(1,3) = w3x
  36. tq(2,3) = w3y
  37. tq(3,3) = w3z
  38. endif
  39. do i = 1,nstep
  40. do j = 1, nstep
  41. q(i,j) = tq(j,i)
  42. enddo
  43. enddo
  44.  
  45. * efficacite
  46. * produit
  47. do i = 1,nstep
  48. do j = 1, nstep
  49. cc= 0.d0
  50. do k1 = 1,nstep
  51. cc = cc + tq(i,k1)*xatef1(k1,j)
  52. enddo
  53. xmat2(i,j) = cc
  54. enddo
  55. enddo
  56. do i = 1,nstep
  57. do j = 1, nstep
  58. cc= 0.d0
  59. do k1 = 1,nstep
  60. cc = cc + xmat2(i,k1)*q(k1,j)
  61. enddo
  62. xatef1(i,j) = cc
  63. enddo
  64. enddo
  65.  
  66.  
  67.  
  68. 1000 CONTINUE
  69. * affecte la rigidite elementaire
  70. c ----------------------------------------
  71. c elements massifs
  72. c ----------------------------------------
  73. if (CELEM.NE.'MASSIF ') goto 2000
  74. kind = int(LRE/NSTEP)
  75. DO jind1 = 1,kind
  76. DO jind2 =1,kind
  77.  
  78. * decoupe un bloc
  79. do in1 = 1,nstep
  80. do in2 = 1, nstep
  81. xmat1(in1,in2) =
  82. & REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2)
  83. * if (ib.eq.1.and.igau.eq.1.and.jind1.eq.1.and.jind2.eq.2)
  84. * & write(6,*) in1,in2,xmat1(in1,in2) ,
  85. * & ((jind1 - 1)*nstep + in1), ((jind2 - 1)*nstep + in2)
  86. enddo
  87. enddo
  88. * multiplie et range
  89. do in1 = 1,nstep
  90. do in2 = 1, nstep
  91. cc = 0.D0
  92. do k1 = 1,nstep
  93. cc = cc + (xatef1(in1,k1) * xmat1(k1,in2))
  94. * if (igau.eq.5.and.jind1.eq.6.and.jind2.eq.7)
  95. * &write(6,*) in1,in2,xatef1(in1,k1) , xmat1(k1,in2)
  96. enddo
  97.  
  98. REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2) = cc
  99. * if (ib.eq.1.and.igau.eq.5.and.jind1.eq.6.and.jind2.eq.7)
  100. * & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2),
  101. * & in1,in2, cc
  102. * if (ib.eq.1.and.igau.eq.5.and.jind1.eq.5)
  103. * & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2),
  104. * & in1,in2, xmat1(in1,in2),cc
  105. enddo
  106. enddo
  107.  
  108.  
  109. ENDDO
  110. ENDDO
  111. RETURN
  112.  
  113. 2000 CONTINUE
  114. c ----------------------------------------
  115. c elements
  116. c ----------------------------------------
  117. RETURN
  118. END
  119.  
  120.  

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