Télécharger fpma3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA3D SOURCE CB215821 19/07/30 21:16:29 10273
  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. C
  61. C BOUCLE SUR LES ELEMENTS
  62. C
  63. DO 1 IB=1,NBELEM
  64. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  65. C
  66. C BOUCLE SUR LES POINTS DE GAUSS
  67. C
  68. DO 10 IGAU=1,NBPGAU
  69. VNQSI1=0.D0
  70. VNQSI2=0.D0
  71. VNQSI3=0.D0
  72. VNETA1=0.D0
  73. VNETA2=0.D0
  74. VNETA3=0.D0
  75. C
  76. T1=0.D0
  77. T2=0.D0
  78. T3=0.D0
  79. C
  80. C BOUCLE SUR LES NOEUDS
  81. C
  82. DO 20 I=1,NBNN
  83. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  84. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  85. VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
  86. VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
  87. VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
  88. VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
  89. 20 CONTINUE
  90. C
  91. IF(IPTVPR.NE.0) THEN
  92. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  93. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  94. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*
  95. 1 MELVA1.VELCHE(IGMN,IBMN)
  96. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*
  97. 1 MELVA1.VELCHE(IGMN,IBMN)
  98. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*
  99. 1 MELVA1.VELCHE(IGMN,IBMN)
  100. ELSE
  101. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*XP
  102. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*XP
  103. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*XP
  104. ENDIF
  105. C
  106. MPTVAL=IVAFOR
  107. DO 30 J=1,NBNN
  108. MELVAL=IVAL(1)
  109. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  110. MELVAL=IVAL(2)
  111. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  112. MELVAL=IVAL(3)
  113. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T3
  114. 30 CONTINUE
  115. 10 CONTINUE
  116. 1 CONTINUE
  117.  
  118. SEGSUP WORK
  119. END
  120.  
  121.  
  122.  

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