Télécharger fpma3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA3D SOURCE FANDEUR 10/08/31 21:17:13 6734
  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. C* SEGACT MINTE <- ACTIF EN E/S
  54. NBPGAU=POIGAU(/1)
  55. C
  56. MELEME=IPMAIL
  57. SEGACT MELEME
  58. NBNN =NUM(/1)
  59. NBELEM=NUM(/2)
  60. C
  61. SEGINI WORK
  62. C
  63. C BOUCLE SUR LES ELEMENTS
  64. C
  65. DO 1 IB=1,NBELEM
  66. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  67. C
  68. C BOUCLE SUR LES POINTS DE GAUSS
  69. C
  70. DO 10 IGAU=1,NBPGAU
  71. VNQSI1=0.D0
  72. VNQSI2=0.D0
  73. VNQSI3=0.D0
  74. VNETA1=0.D0
  75. VNETA2=0.D0
  76. VNETA3=0.D0
  77. C
  78. T1=0.D0
  79. T2=0.D0
  80. T3=0.D0
  81. C
  82. C BOUCLE SUR LES NOEUDS
  83. C
  84. DO 20 I=1,NBNN
  85. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  86. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  87. VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
  88. VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
  89. VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
  90. VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
  91. 20 CONTINUE
  92. C
  93. IF(IPTVPR.NE.0) THEN
  94. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  95. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  96. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*
  97. 1 MELVA1.VELCHE(IGMN,IBMN)
  98. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*
  99. 1 MELVA1.VELCHE(IGMN,IBMN)
  100. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*
  101. 1 MELVA1.VELCHE(IGMN,IBMN)
  102. ELSE
  103. T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*XP
  104. T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*XP
  105. T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*XP
  106. ENDIF
  107. C
  108. MPTVAL=IVAFOR
  109. DO 30 J=1,NBNN
  110. MELVAL=IVAL(1)
  111. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  112. MELVAL=IVAL(2)
  113. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  114. MELVAL=IVAL(3)
  115. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T3
  116. 30 CONTINUE
  117. 10 CONTINUE
  118. 1 CONTINUE
  119.  
  120. SEGSUP WORK
  121. IF(IPTVPR.NE.0) SEGDES MELVA1
  122. SEGDES MELEME
  123. C* SEGDES,MINTE <- ACTIF EN E/S
  124.  
  125. RETURN
  126. END
  127.  
  128.  
  129.  

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