Télécharger fpco2d.eso

Retour à la liste

Numérotation des lignes :

fpco2d
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. *
  35. SEGMENT MPTVAL
  36. INTEGER IPOS(NS) ,NSOF(NS)
  37. INTEGER IVAL(NCOSOU)
  38. CHARACTER*16 TYVAL(NCOSOU)
  39. ENDSEGMENT
  40. *
  41. DIMENSION XE(3,3)
  42. *
  43. MELVA1=IPTVPR
  44. *
  45. MELEME=IPMAIL
  46. SEGACT MELEME
  47. NBELEM=NUM(/2)
  48. IGMN=MIN(2,MELVA1.VELCHE(/1))
  49. DIM3=1.D0
  50. *
  51. * BOUCLE SUR LES ELEMENTS
  52. *
  53. DO 1 IB=1,NBELEM
  54. C
  55. C RECUPERATION DE L'EPAISSEUR
  56. C
  57. IF (IFOUR.EQ.-2) THEN
  58. MPTVAL=IVACAR
  59. IF (IVACAR.NE.0) THEN
  60. C
  61. C DIM3 EST LA DERNIERE COMPOSANTE DE IVACAR
  62. C (CF FPCOQU ET BSIGMP)
  63. C
  64. MELVAL=IVAL(IVAL(/1))
  65. IF (MELVAL.NE.0) THEN
  66. IBMN=MIN(IB,VELCHE(/2))
  67. DIM3=VELCHE(IGMN,IBMN)
  68. ENDIF
  69. ENDIF
  70. ENDIF
  71. *
  72. CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
  73. R1=XE(1,1)
  74. R2=XE(1,2)
  75. Z1=XE(2,1)
  76. Z2=XE(2,2)
  77. *
  78. D2=(R2-R1)*(R2-R1)+(Z2-Z1)*(Z2-Z1)
  79. D=SQRT(D2)
  80. UNSD=1.D0/D
  81. A=(R2-R1)*UNSD
  82. B=(Z2-Z1)*UNSD
  83. IF(IFOUR.LT.0) THEN
  84. R1=1.D0
  85. R2=1.D0
  86. ELSEIF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.
  87. + NIFOUR.EQ.0)) THEN
  88. R1=2*XPI*R1
  89. R2=2*XPI*R2
  90. ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  91. R1=XPI*R1
  92. R2=XPI*R2
  93. ENDIF
  94. IF (IFOUR.EQ.-2) THEN
  95. R1=R1*DIM3
  96. R2=R2*DIM3
  97. ENDIF
  98. IF(IFOUR.LE.0) IFO=0
  99. IF(IFOUR.EQ.1) IFO=1
  100. *
  101. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  102. P1=MELVA1.VELCHE(1,IBMN)
  103. P2=MELVA1.VELCHE(IGMN,IBMN)
  104. *
  105. PA=P1*R1
  106. PB=P1*R2+P2*R1-2.D0*P1*R1
  107. PC=(P2-P1)*(R2-R1)
  108. *
  109. FP1=D*(PA*0.5D0+PB*0.15D0+PC/15.D0)
  110. XO1=D2*(PA/12.D0+PB/30.D0+PC/60.D0)
  111. FP2=D*(PA*0.5D0+PB*0.35D0+PC*4.D0/15.D0)
  112. XO2=-D2*(PA/12.D0+PB/20.D0+PC/30.D0)
  113. *
  114. MPTVAL=IVAFOR
  115. MELVAL=IVAL(1)
  116. VELCHE(1,IB)=-B*FP1
  117. VELCHE(2,IB)=-B*FP2
  118. *
  119. MELVAL=IVAL(2)
  120. VELCHE(1,IB)=A*FP1
  121. VELCHE(2,IB)=A*FP2
  122. *
  123. MELVAL=IVAL(3+IFO)
  124. VELCHE(1,IB)=XO1
  125. VELCHE(2,IB)=XO2
  126. *
  127. 1 CONTINUE
  128. RETURN
  129. END
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  

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