Télécharger fpco2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPCO2D SOURCE MB234859 16/09/16 21:15:18 9091
  2. SUBROUTINE FPCO2D(IPTVPR,IPMAIL,IVAFOR,IVACAR)
  3. *____________________________________________________________________
  4. *
  5. * CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
  6. * COQUES BIDIMENSIONNELS
  7. *
  8. *
  9. * ENTREES :
  10. * ---------
  11. *
  12. * IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  13. * (actif)
  14. * IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE (actif)
  15. * IVAFOR POINTEUR SUR UN MPTVAL ET UN MELVAL DEVANT CONTENIR LES
  16. * FORCES NODALES RESULTANTES
  17. *
  18. *
  19. * JACQUELINE BROCHARD AVRIL 85
  20. * PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 12 09 90
  21. * REPRISE MILL AVRIL 91 ON SUPPOSE QUE LES PRESSIONS SONT
  22. * DONNEES AUX NOEUDS
  23. *____________________________________________________________________
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC CCREEL
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMCOORD
  31. -INC CCOPTIO
  32. *
  33. SEGMENT MPTVAL
  34. INTEGER IPOS(NS) ,NSOF(NS)
  35. INTEGER IVAL(NCOSOU)
  36. CHARACTER*16 TYVAL(NCOSOU)
  37. ENDSEGMENT
  38. *
  39. DIMENSION XE(3,3)
  40. *
  41. MELVA1=IPTVPR
  42. *
  43. MELEME=IPMAIL
  44. SEGACT MELEME
  45. NBELEM=NUM(/2)
  46. IGMN=MIN(2,MELVA1.VELCHE(/1))
  47. DIM3=1.D0
  48. *
  49. * BOUCLE SUR LES ELEMENTS
  50. *
  51. DO 1 IB=1,NBELEM
  52. C
  53. C RECUPERATION DE L'EPAISSEUR
  54. C
  55. IF (IFOUR.EQ.-2) THEN
  56. MPTVAL=IVACAR
  57. IF (IVACAR.NE.0) THEN
  58. C
  59. C DIM3 EST LA DERNIERE COMPOSANTE DE IVACAR
  60. C (CF FPCOQU ET BSIGMP)
  61. C
  62. MELVAL=IVAL(IVAL(/1))
  63. IF (MELVAL.NE.0) THEN
  64. IBMN=MIN(IB,VELCHE(/2))
  65. DIM3=VELCHE(IGMN,IBMN)
  66. ENDIF
  67. ENDIF
  68. ENDIF
  69. *
  70. CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
  71. R1=XE(1,1)
  72. R2=XE(1,2)
  73. Z1=XE(2,1)
  74. Z2=XE(2,2)
  75. *
  76. D2=(R2-R1)*(R2-R1)+(Z2-Z1)*(Z2-Z1)
  77. D=SQRT(D2)
  78. UNSD=1.D0/D
  79. A=(R2-R1)*UNSD
  80. B=(Z2-Z1)*UNSD
  81. IF(IFOUR.LT.0) THEN
  82. R1=1.D0
  83. R2=1.D0
  84. ELSEIF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.
  85. + NIFOUR.EQ.0)) THEN
  86. R1=2*XPI*R1
  87. R2=2*XPI*R2
  88. ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  89. R1=XPI*R1
  90. R2=XPI*R2
  91. ENDIF
  92. IF (IFOUR.EQ.-2) THEN
  93. R1=R1*DIM3
  94. R2=R2*DIM3
  95. ENDIF
  96. IF(IFOUR.LE.0) IFO=0
  97. IF(IFOUR.EQ.1) IFO=1
  98. *
  99. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  100. P1=MELVA1.VELCHE(1,IBMN)
  101. P2=MELVA1.VELCHE(IGMN,IBMN)
  102. *
  103. PA=P1*R1
  104. PB=P1*R2+P2*R1-2.D0*P1*R1
  105. PC=(P2-P1)*(R2-R1)
  106. *
  107. FP1=D*(PA*0.5D0+PB*0.15D0+PC/15.D0)
  108. XO1=D2*(PA/12.D0+PB/30.D0+PC/60.D0)
  109. FP2=D*(PA*0.5D0+PB*0.35D0+PC*4.D0/15.D0)
  110. XO2=-D2*(PA/12.D0+PB/20.D0+PC/30.D0)
  111. *
  112. MPTVAL=IVAFOR
  113. MELVAL=IVAL(1)
  114. VELCHE(1,IB)=-B*FP1
  115. VELCHE(2,IB)=-B*FP2
  116. *
  117. MELVAL=IVAL(2)
  118. VELCHE(1,IB)=A*FP1
  119. VELCHE(2,IB)=A*FP2
  120. *
  121. MELVAL=IVAL(3+IFO)
  122. VELCHE(1,IB)=XO1
  123. VELCHE(2,IB)=XO2
  124. *
  125. 1 CONTINUE
  126. RETURN
  127. END
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  

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