Télécharger fpco3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPCO3D SOURCE PV 09/03/12 21:23:03 6325
  2. SUBROUTINE FPCO3D(IPTVPR,IPMAIL,IVAFOR)
  3. C____________________________________________________________________
  4. C
  5. C CALCULE LES FORCES DE PRESSIONS SUR LES COQUES 3D
  6. C
  7. C
  8. C ENTREES :
  9. C ---------
  10. C
  11. C IPTVPR MELVAL CONTENANT LES PRESSIONS APPLIQUEES (ACTIF)
  12. C IPMAIL OBJET GEOMETRIQUE (ACTIF)
  13. C IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  14. C NODALE RESULTANTES
  15. C
  16. C JACQUELINE BROCHARD AVRIL 85
  17. C PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 21 09 90
  18. C
  19. C____________________________________________________________________
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. C
  24. -INC SMCHAML
  25. -INC SMELEME
  26. -INC SMCOORD
  27. -INC CCOPTIO
  28. C
  29. SEGMENT MPTVAL
  30. INTEGER IPOS(NS) ,NSOF(NS)
  31. INTEGER IVAL(NCOSOU)
  32. CHARACTER*16 TYVAL(NCOSOU)
  33. ENDSEGMENT
  34. C
  35. DIMENSION XE(3,3),XEL(3,3),BPSS(3,3),BB(9),FT(18),F(6)
  36. DIMENSION XX(3),YY(3)
  37. C
  38. DATA XX/0.5D0,0.5D0,0.0D0/
  39. DATA YY/0.0D0,0.5D0,0.5D0/
  40. DATA UNTIER/.33333333333333333D0/
  41. C
  42. MELVA1=IPTVPR
  43. IGMN=MIN(3,MELVA1.VELCHE(/1))
  44. C
  45. MELEME=IPMAIL
  46. NBELEM=NUM(/2)
  47. C
  48. C BOUCLE SUR LES ELEMENTS
  49. C
  50. DO 1000 IB=1,NBELEM
  51. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  52. IF (IGMN.EQ.1) THEN
  53. *
  54. * Champ constant
  55. *
  56. P=MELVA1.VELCHE(1,IBMN)
  57. ELSE
  58. *
  59. * P moyen sur l'element
  60. *
  61. P=0.D0
  62. DO 11 IGAU=1,3
  63. P=MELVA1.VELCHE(IGAU,IBMN)+P
  64. 11 CONTINUE
  65. P=P/3
  66. ENDIF
  67. CALL DOXE(XCOOR,IDIM,3,NUM,IB,XE)
  68. C
  69. C MATRICE DE PASSAGE
  70. C
  71. CALL VPAST(XE,BPSS)
  72. C
  73. C COORDONNEES LOCALES
  74. C
  75. CALL VCORLC(XE,XEL,BPSS)
  76. C
  77. C MISE A 0 DU VECTEUR FORCE
  78. C
  79. DO 100 I=1,18
  80. 100 FT(I)=0.D0
  81. X21=XEL(1,2)-XEL(1,1)
  82. Y31=XEL(2,3)-XEL(2,1)
  83. SURF=X21*Y31*.5D0
  84. C
  85. C INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  86. C IA NUMERO D UN NOEUD
  87. C
  88. DO 200 IGAU=1,3
  89. CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB)
  90. DO 210 IA=1,3
  91. IP=(IA-1)*6+2
  92. IK=(IA-1)*3
  93. DO 220 ID=1,3
  94. FT(IP+ID)=FT(IP+ID)+UNTIER*BB(IK+ID)
  95. 220 CONTINUE
  96. 210 CONTINUE
  97. 200 CONTINUE
  98. C
  99. C MULTIPLICATION PAR P*SURF
  100. C
  101. DO 300 I=1,18
  102. FT(I)=FT(I)*SURF*P
  103. 300 CONTINUE
  104. C
  105. C CHANGEMENT DE REPERE
  106. C
  107. DO 400 I=1,3
  108. KP=6*(I-1)
  109. MP=KP+3
  110. DO 401 II=1,6
  111. 401 F(II)=0.D0
  112. DO 402 J=1,3
  113. LP=J
  114. NP=LP+3
  115. DO 403 JP=1,3
  116. F(LP)=F(LP)+BPSS(JP,J)*FT(JP+KP)
  117. F(NP)=F(NP)+BPSS(JP,J)*FT(JP+MP)
  118. 403 CONTINUE
  119. 402 CONTINUE
  120. MPTVAL=IVAFOR
  121. DO 410 K=1,6
  122. MELVAL=IVAL(K)
  123. VELCHE(I,IB)=F(K)
  124. 410 CONTINUE
  125. 400 CONTINUE
  126. 1000 CONTINUE
  127. RETURN
  128. END
  129.  
  130.  
  131.  
  132.  
  133.  

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