Télécharger fpma2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA2D SOURCE FANDEUR 10/08/31 21:17:11 6734
  2. SUBROUTINE FPMA2D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IVACAR,XP)
  3. C
  4. C____________________________________________________________________
  5. C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
  6. C MASSIFS BIDIMENSIONNELS
  7. C
  8. C ENTREES :
  9. C ---------
  10. C
  11. C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  12. C 0 SI ON A DONNE UNE VALEUR CONSTANTE
  13. C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  14. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  15. C (ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION)
  16. C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES
  17. C NODALE RESULTANTES
  18. C IVACAR POINTEUR SUR UN MELVAL DE CARACTERISTIQUES
  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 CCREEL
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMCOORD
  34. -INC CCOPTIO
  35. C
  36. C= Quelques constantes (2.Pi)
  37. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  38.  
  39. SEGMENT WORK
  40. REAL*8 XE(3,NBNN)
  41. ENDSEGMENT
  42. C
  43. SEGMENT MPTVAL
  44. INTEGER IPOS(NS) ,NSOF(NS)
  45. INTEGER IVAL(NCOSOU)
  46. CHARACTER*16 TYVAL(NCOSOU)
  47. ENDSEGMENT
  48. C
  49. * prob optimiseur il faut initialiser melva1
  50. MELVA1=IVAFOR
  51. IF(IPTVPR.NE.0) THEN
  52. MELVA1=IPTVPR
  53. SEGACT MELVA1
  54. ENDIF
  55. MELVAL=MELVA1
  56. C
  57. MINTE=IPTINT
  58. C* SEGACT MINTE <- ACTIF EN E/S
  59. NBPGAU=POIGAU(/1)
  60. C
  61. MELEME=IPMAIL
  62. SEGACT MELEME
  63. NBNN =NUM(/1)
  64. NBELEM=NUM(/2)
  65. SEGINI WORK
  66. DIM3=1.D0
  67. C
  68. C BOUCLE SUR LES ELEMENTS
  69. C
  70. DO 1 IB=1,NBELEM
  71. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  72. C
  73. C BOUCLE SUR LES POINTS DE GAUSS
  74. C
  75. DO 10 IGAU=1,NBPGAU
  76. C
  77. C RECUPERATION DE L'EPAISSEUR
  78. C
  79. IF (IFOUR.EQ.-2) THEN
  80. MPTVAL=IVACAR
  81. IF (IVACAR.NE.0) THEN
  82. IF(IVAL(1).NE.0) THEN
  83. MELVAL=IVAL(1)
  84. IGMN=MIN(IGAU,VELCHE(/1))
  85. IBMN=MIN(IB,VELCHE(/2))
  86. DIM3=VELCHE(IGMN,IBMN)
  87. ELSE
  88. DIM3=1.D0
  89. ENDIF
  90. ENDIF
  91. ENDIF
  92. *
  93. VNQSI1=0.D0
  94. VNQSI2=0.D0
  95. T1=0.D0
  96. T2=0.D0
  97. R=0.D0
  98. C
  99. C BOUCLE SUR LES NOEUDS
  100. C
  101. DO 20 I=1,NBNN
  102. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  103. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  104. R=R+SHPTOT(1,I,IGAU)*XE(1,I)
  105. 20 CONTINUE
  106. IF (IFOUR.LT.0) THEN
  107. R=1.D0
  108. ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  109. + .AND.NIFOUR.EQ.0)) THEN
  110. R=X2PI*R
  111. ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  112. R=XPI*R
  113. ENDIF
  114. IF (IFOUR.EQ.-2) R=R*DIM3
  115. *
  116. IF(IPTVPR.NE.0) THEN
  117. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  118. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  119. T1=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*(-VNQSI2)
  120. T2=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*VNQSI1
  121. ELSE
  122. T1=POIGAU(IGAU)*XP*R*(-VNQSI2)
  123. T2=POIGAU(IGAU)*XP*R*VNQSI1
  124. ENDIF
  125. C
  126. MPTVAL=IVAFOR
  127. DO 30 J=1,NBNN
  128. MELVAL=IVAL(1)
  129. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  130. MELVAL=IVAL(2)
  131. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  132. 30 CONTINUE
  133. C
  134. 10 CONTINUE
  135. 1 CONTINUE
  136. SEGSUP WORK
  137. C* SEGDES,MINTE <- ACTIF EN E/S
  138. SEGDES,MELEME
  139. IF(IPTVPR.NE.0) SEGDES MELVA1
  140. RETURN
  141. END
  142.  
  143.  
  144.  

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