Télécharger fsco2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FSCO2D SOURCE FANDEUR 12/07/18 21:15:37 7434
  2. *
  3. SUBROUTINE FSCO2D(IPT,IPMAIL,IPVECT,V,IVAFOR,IVACAR)
  4. *
  5. *_______________________________________________________________________
  6. *
  7. * CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS
  8. * COQUES BIDIMENSIONNELS
  9. *
  10. * ENTREES :
  11. * ---------
  12. *
  13. * IPT TABLEAU DE POINTEUR SUR UN MPTVAL CONTENANT LES FORCES
  14. * APPLIQUEES
  15. * 0 SI ON A DONNE UNE FORCE CONSTANTE
  16. * IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  17. * IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  18. * V VECTEUR REPRESENTANT LA FORCE
  19. * IVAFOR POINTEUR SUR UN MPTVAL ET UN MELVAL DEVANT CONTENIR LES
  20. * FORCES NODALES RESULTANTES
  21. *
  22. *_______________________________________________________________________
  23. *
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. *
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMCOORD
  33. *
  34. SEGMENT MPTVAL
  35. INTEGER IPOS(NS) ,NSOF(NS)
  36. INTEGER IVAL(NCOSOU)
  37. CHARACTER*16 TYVAL(NCOSOU)
  38. ENDSEGMENT
  39. *
  40. DIMENSION IPT(*),V(*)
  41. DIMENSION XE(3,2)
  42. *
  43. PARAMETER ( X2Pi = 6.283185307179586476925286766559D0 )
  44. *
  45. MELVA1 = IPT(1)
  46. MELVA2 = IPT(2)
  47. IF (IPVECT.EQ.0) THEN
  48. F11I = XZero
  49. F12I = XZero
  50. F21I = XZero
  51. F22I = XZero
  52. IF (MELVA1.NE.0) THEN
  53. SEGACT,MELVA1
  54. IGM1 = MIN(2,MELVA1.VELCHE(/1))
  55. IBM1 = MELVA1.VELCHE(/2)
  56. ENDIF
  57. IF (MELVA2.NE.0) THEN
  58. SEGACT,MELVA2
  59. IGM2 = MIN(2,MELVA2.VELCHE(/1))
  60. IBM2 = MELVA2.VELCHE(/2)
  61. ENDIF
  62. ELSE
  63. F11I = V(1)
  64. F12I = V(2)
  65. F21I = V(1)
  66. F22I = V(2)
  67. ENDIF
  68. *
  69. MELEME=IPMAIL
  70. C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE)
  71. C* NBNN=NUM(/1)
  72. NBELEM=NUM(/2)
  73. C
  74. C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
  75. C
  76. DIM3 = 1.D0
  77. MELVA3 = 0
  78. IF (IVACAR.NE.0 .AND. IFOUR.EQ.-2) THEN
  79. MPTVAL = IVACAR
  80. MELVA3 = IVAL(1)
  81. IF (MELVA3.NE.0) THEN
  82. IGM3 = MELVA3.VELCHE(/1)
  83. IBM3 = MELVA3.VELCHE(/2)
  84. ENDIF
  85. ENDIF
  86.  
  87. IF (IFOUR.LE.0) THEN
  88. IFO = 0
  89. ELSE IF (IFOUR.EQ.1)THEN
  90. IFO = 1
  91. ENDIF
  92. *
  93. MPTVAL = IVAFOR
  94. *
  95. * BOUCLE SUR LES ELEMENTS
  96. *
  97. DO 1 IB = 1, NBELEM
  98. C
  99. C RECUPERATION DE L'EPAISSEUR SI DEFINIE
  100. C
  101. IF (MELVA3.NE.0) THEN
  102. IBMN = MIN(IB,IBM3)
  103. *OF Valeur constante par element ?
  104. DIM3 = MELVA3.VELCHE(IGM3,IBMN)
  105. ENDIF
  106. *
  107. CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
  108.  
  109. R1 = XE(1,1)
  110. R2 = XE(1,2)
  111.  
  112. A = R2 - R1
  113. B = XE(2,2) - XE(2,1)
  114. D2 = A*A + B*B
  115. D = SQRT(D2)
  116. UNSD = 1.D0/D
  117. A = A * UNSD
  118. B = B * UNSD
  119.  
  120. IF (IFOUR.LT.0) THEN
  121. IF (IFOUR.EQ.-2) THEN
  122. R1 = DIM3
  123. R2 = DIM3
  124. ELSE
  125. R1 = 1.D0
  126. R2 = 1.D0
  127. ENDIF
  128. ELSE IF (IFOUR.EQ.0) THEN
  129. R1 = X2Pi * R1
  130. R2 = X2Pi * R2
  131. C* ELSE IF (IFOUR.EQ.1) THEN
  132. ELSE
  133. IF (NIFOUR.EQ.0) THEN
  134. R1 = X2Pi * R1
  135. R2 = X2Pi * R2
  136. ELSE
  137. R1 = XPI * R1
  138. R2 = XPI * R2
  139. ENDIF
  140. ENDIF
  141. *
  142. IF (IPVECT.EQ.0) THEN
  143. IF (MELVA1.NE.0) THEN
  144. IBMN = MIN(IB,IBM1)
  145. F11I = MELVA1.VELCHE(1,IBMN)
  146. F21I = MELVA1.VELCHE(IGM1,IBMN)
  147. ENDIF
  148. IF (MELVA2.NE.0) THEN
  149. IBMN = MIN(IB,IBM2)
  150. F12I = MELVA2.VELCHE(1,IBMN)
  151. F22I = MELVA2.VELCHE(IGM2,IBMN)
  152. ENDIF
  153. ENDIF
  154. *
  155. * chgt repère du vecteur F: global -> local
  156. *
  157. F11 = A*F11I + B*F12I
  158. F12 = -B*F11I + A*F12I
  159. F21 = A*F21I + B*F22I
  160. F22 = -B*F21I + A*F22I
  161. *
  162. FA = F12*R1
  163. FB = F12*R2 + F22*R1 - 2.D0*F12*R1
  164. FC = (F22-F12)*(R2-R1)
  165. *
  166. XO1 = D2 * (FA/12.D0+FB/30.D0+FC/60.D0)
  167. XO2 =-D2 * (FA/12.D0+FB/20.D0+FC/30.D0)
  168. *
  169. FP12 = D * (FA*0.5D0+FB*0.15D0+FC/15.D0)
  170. FP22 = D * (FA*0.5D0+FB*0.35D0+FC*4.D0/15.D0)
  171. *
  172. IF (IFOUR.EQ.0) THEN
  173. FD=F11*R1
  174. FE=F21*R2
  175. FF=F21*R1 + F11*R2 + FE
  176. FG=F21*R1 + F11*R2 + FD
  177. FP11=D*(FD/4.D0 + FF/12.D0)
  178. FP21=D*(FE/4.D0 + FG/12.D0)
  179. ELSE
  180. FP11=D*(F11/3.D0 + F21/6.D0)
  181. FP21=D*(F21/3.D0 + F11/6.D0)
  182. ENDIF
  183. *
  184. MELVAL = IVAL(1)
  185. VELCHE(1,IB) = -B*FP12 + A*FP11
  186. VELCHE(2,IB) = -B*FP22 + A*FP21
  187. *
  188. MELVAL = IVAL(2)
  189. VELCHE(1,IB) = A*FP12 + B*FP11
  190. VELCHE(2,IB) = A*FP22 + B*FP21
  191. *
  192. MELVAL = IVAL(3+IFO)
  193. VELCHE(1,IB) = XO1
  194. VELCHE(2,IB) = XO2
  195. *
  196. 1 CONTINUE
  197.  
  198. IF (IPVECT.EQ.0) THEN
  199. IF (MELVA1.NE.0) SEGDES,MELVA1
  200. IF (MELVA2.NE.0) SEGDES,MELVA2
  201. ENDIF
  202. C* SEGDES,MELEME <- ACTIF EN E/S (NON MODIFIE)
  203.  
  204. RETURN
  205. END
  206.  
  207.  
  208.  

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