Télécharger fpma3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA3D SOURCE CB215821 20/01/21 21:15:11 10505
  2. SUBROUTINE FPMA3D(IPTVPR,IPMAIL,IPTINT,IVAFOR,XP)
  3. C
  4. C____________________________________________________________________
  5. C
  6. C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
  7. C MASSIFS TRIDIMENSIONNELS
  8. C
  9. C ENTREES :
  10. C ---------
  11. C
  12. C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  13. C 0 SI ON A DONNE UNE PRESSION CONSTANTE
  14. C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  15. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  16. C ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION
  17. C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES
  18. C NODALES RESUL
  19. C
  20. C JACQUELINE BROCHARD AVRIL 85
  21. C
  22. C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90
  23. C
  24. C______________________________________________________________________
  25. C
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. C
  29. -INC SMCHAML
  30. -INC SMELEME
  31. -INC SMINTE
  32. -INC SMCOORD
  33. -INC CCOPTIO
  34. C
  35. SEGMENT MPTVAL
  36. INTEGER IPOS(NS),NSOF(NS)
  37. INTEGER IVAL(NCOSOU)
  38. CHARACTER*16 TYVAL(NCOSOU)
  39. ENDSEGMENT
  40. C
  41. SEGMENT WORK
  42. REAL*8 XE(3,NBNN)
  43. ENDSEGMENT
  44. C
  45. * pour daire plaisir a l'optimiseur
  46. melva1=iptint
  47. IF(IPTVPR.NE.0) THEN
  48. MELVA1=IPTVPR
  49. SEGACT MELVA1
  50. ENDIF
  51. C
  52. MINTE=IPTINT
  53. NBPGAU=POIGAU(/1)
  54. C
  55. MELEME=IPMAIL
  56. NBNN =NUM(/1)
  57. NBELEM=NUM(/2)
  58. C
  59. SEGINI WORK
  60. SEGACT,MCOORD
  61. C
  62. C BOUCLE SUR LES ELEMENTS
  63. C
  64. DO 1 IB=1,NBELEM
  65. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  66. C
  67. C BOUCLE SUR LES POINTS DE GAUSS
  68. C
  69. DO 10 IGAU=1,NBPGAU
  70. VNQSI1=0.D0
  71. VNQSI2=0.D0
  72. VNQSI3=0.D0
  73. VNETA1=0.D0
  74. VNETA2=0.D0
  75. VNETA3=0.D0
  76. C
  77. T1=0.D0
  78. T2=0.D0
  79. T3=0.D0
  80. C
  81. C BOUCLE SUR LES NOEUDS
  82. C
  83. DO 20 I=1,NBNN
  84. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  85. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  86. VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
  87. VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
  88. VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
  89. VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
  90. 20 CONTINUE
  91. C
  92. IF(IPTVPR.NE.0) THEN
  93. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  94. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  95. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*
  96. 1 MELVA1.VELCHE(IGMN,IBMN)
  97. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*
  98. 1 MELVA1.VELCHE(IGMN,IBMN)
  99. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*
  100. 1 MELVA1.VELCHE(IGMN,IBMN)
  101. ELSE
  102. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*XP
  103. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*XP
  104. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*XP
  105. ENDIF
  106. C
  107. MPTVAL=IVAFOR
  108. MELVAL=IVAL(1)
  109. DO J=1,NBNN
  110. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  111. ENDDO
  112. MELVAL=IVAL(2)
  113. DO J=1,NBNN
  114. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  115. ENDDO
  116. MELVAL=IVAL(3)
  117. DO J=1,NBNN
  118. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T3
  119. ENDDO
  120. 10 CONTINUE
  121. 1 CONTINUE
  122. SEGDES,MCOORD
  123.  
  124. SEGSUP WORK
  125. END
  126.  
  127.  
  128.  

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