Télécharger flacoq.eso

Retour à la liste

Numérotation des lignes :

flacoq
  1. C FLACOQ SOURCE CHAT 05/01/13 00:02:57 5004
  2. SUBROUTINE FLACOQ(RE,XA,EP,CONT,XE,YE,ZE,P,XX,YY,BB,
  3. 1 CC,RQP,RJ,SIG)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION CONT(*)
  7. DIMENSION RE(18,18),XA(3,3),SIG(3),JLIM(2,9),RJ(2,2),RP(9,9)
  8. 1 ,RL(9,9)
  9. DIMENSION P(3,3),XX(3,3),YY(3,3),BB(3),CC(3),
  10. 1 XE(3),YE(3),ZE(3)
  11. DIMENSION RQP(18,18)
  12. DATA JLIM/1,1,2,3,2,3,4,4,5, 6,5,6,7,7,8,9,8,9/
  13. DATA RL/ 0., 0., 0., 0. ,0. ,0. , 1. ,0. ,0. ,
  14. 1 1., 0., 0., 0. ,0. ,0. , -1. ,0. ,0. ,
  15. 2 0., 0., 0., 1. ,0. ,0. , -1. ,0. ,0. ,
  16. 3 0., -0.5,0.5,0.,0.5,-0.5, 0., 0., 0.,
  17. 4 0., 0., 0., 0., 0., -0.5, 0., 0., 0.5,
  18. 6 0.,-0.5, 0., 0., 0., 0., 0., 0.5, 0.,
  19. 7 -1., 0.5, -0.5, 1., 0.5, -0.5, 0., 0., 0.,
  20. 8 0., 0., 0., -1., 0., 0.5, 1., 0., 0.5,
  21. 9 1., -0.5, 0., 0., 0., 0., -1., -0.5, 0./
  22. DATA RP/ 1., 0., 0., 0., 0., 0., 0., 0., 0.,
  23. 2 0., 0., 0., 0., 0., 0., 0., 0., 0.,
  24. 3 0., 0., 0., 0., 0., 0., 0., 0., 0.,
  25. 4 0., 0., 0., 1., 0., 0., 0., 0., 0.,
  26. 5 0., 0., 0., 0., 0., 0., 0., 0., 0.,
  27. 6 0., 0., 0., 0., 0., 0., 0., 0., 0.,
  28. 7 0., 0., 0., 0., 0., 0., 1., 0., 0.,
  29. 8 0., 0., 0., 0., 0., 0., 0., 0., 0.,
  30. 9 0., 0., 0., 0., 0., 0., 0., 0., 0./
  31. C JUSQU A NOUVEL ORDRE LA PRESSION SERA NULLE PRENO=0.
  32. PRENO=0.
  33. DO 151 I=1,3
  34. XE(I)=XA(1,I)
  35. YE(I)=XA(2,I)
  36. 151 ZE(I)=XA(3,I)
  37. CALL PASSA(XE,YE,ZE, P,X13,X23,Y13,Y23)
  38. RJ(1,1)=Y13
  39. RJ(2,1)=Y23
  40. RJ(1,2)= -X13
  41. RJ(2,2)=-X23
  42. DO 1 K=1,3
  43. IK=3*K-2
  44. DO 1 I=1,2
  45. II=IK+I
  46. DO 1 J=1,2
  47. IJ=IK+J
  48. 1 RP(IJ,II)=RJ(J,I)
  49. DT=X13*Y23-Y13*X23
  50. SURF=DT
  51. SIG(1)=+CONT(1)
  52. SIG(2)=+CONT(2)
  53. SIG(3)=+CONT(3)
  54. DT=1./ABS(DT)
  55. C ****** K SIG ET K P CALCULES AVEC W LINEAIRES ********
  56. C *****************
  57. C ****** BUNG 7 2 79 **************
  58. SURF=0.
  59. DO 12 I=1,18
  60. DO 12 J=1,18
  61. 12 RQP(J,I)=0.
  62. BB(1)=Y23
  63. BB(2)=-Y13
  64. BB(3)=0.
  65. CC(1)=-X23
  66. CC(2)=X13
  67. CC(3)=X23-X13
  68. SIG(1)= SIG(1)*EP*0.50*DT
  69. SIG(2)= SIG(2)*EP*0.50*DT
  70. SIG(3)= SIG(3)*EP*0.50*DT
  71. DO 16 J=1,3
  72. JJ=(J-1)*6+1
  73. DO 17 I=1,3
  74. II=(I-1)*6+1
  75. S= SIG(1)*BB(I)*BB(J)+SIG(2)*CC(I)*CC(J) +
  76. 1 SIG(3)*(BB(I)*CC(J)+BB(J)*CC(I))
  77. RQP(II,JJ)= RQP(II,JJ)+S
  78. RQP(II+1,JJ+1)=RQP(II+1,JJ+1)+S
  79. RQP(II+2,JJ+2)=RQP(II+2,JJ+2)+S
  80. 17 CONTINUE
  81. 16 CONTINUE
  82.  
  83. C CALCUL DE KP A PARTIR DES DEPLACEMENTS
  84. AUX=PRENO / 12.
  85. A1=AUX*(Y13+Y23)
  86. A2= AUX*(X13+X23)
  87. A3= AUX*(X13-2.*X23)
  88. A4 =AUX* (2.*X13-X23)
  89. A5=AUX*Y23
  90. A6= AUX*Y13
  91. RQP(1,9)= A1
  92. RQP(9,1)=RQP(1,9)
  93. RQP(1,15)= A5
  94. RQP(15,1)=RQP(1,15)
  95. RQP(2,9)= -A2
  96. RQP(9,2)=RQP(2,9)
  97. RQP(2,15)= A3
  98. RQP(15,2)=RQP(2,15)
  99. RQP(7,3)= -A1
  100. RQP(3,7)=RQP(7,3)
  101. RQP(7,15)= -A6
  102. RQP(15,7)=RQP(7,15)
  103. RQP(8,3)= A2
  104. RQP(3,8)=RQP(8,3)
  105. RQP(8,15)= A4
  106. RQP(15,8)= RQP(8,15)
  107. RQP(13,3) = -A5
  108. RQP(3,13) =RQP(13,3)
  109. RQP(13,9)= A6
  110. RQP(9,13) = RQP(13,9 )
  111. RQP(14,3)= -A3
  112. RQP(3,14)= RQP(14,3)
  113. RQP(14,9) = -A4
  114. RQP(9,14) = RQP(14,9)
  115. DO 6 K=1,6
  116. K1=3*(K-1)
  117. DO 6 L=K,6
  118. L1= 3*(L-1)
  119. DO 7 I=1,3
  120. IM=I+K1
  121. DO 7 J=1,3
  122. JM=J+L1
  123. 7 XX(I,J)= RQP(IM,JM)
  124. CALL PRODT(YY,XX,P,3,3)
  125. DO 8 I=1,3
  126. IM=I+K1
  127. DO 8 J=1,3
  128. JM=J+L1
  129. 8 RE(IM,JM)=YY(I,J)
  130. 6 CONTINUE
  131. DO 290 I=1,18
  132. DO 290 J=I,18
  133. 290 RE(J,I)= RE( I,J)
  134. RETURN
  135. END
  136.  
  137.  

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