Télécharger fpma2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA2D SOURCE CB215821 19/07/30 21:16:28 10273
  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. ENDIF
  54. MELVAL=MELVA1
  55. C
  56. MINTE=IPTINT
  57. NBPGAU=POIGAU(/1)
  58. C
  59. MELEME=IPMAIL
  60. NBNN =NUM(/1)
  61. NBELEM=NUM(/2)
  62. SEGINI WORK
  63. DIM3=1.D0
  64. C
  65. C BOUCLE SUR LES ELEMENTS
  66. C
  67. DO 1 IB=1,NBELEM
  68. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  69. C
  70. C BOUCLE SUR LES POINTS DE GAUSS
  71. C
  72. DO 10 IGAU=1,NBPGAU
  73. C
  74. C RECUPERATION DE L'EPAISSEUR
  75. C
  76. IF (IFOUR.EQ.-2) THEN
  77. MPTVAL=IVACAR
  78. IF (IVACAR.NE.0) THEN
  79. IF(IVAL(1).NE.0) THEN
  80. MELVAL=IVAL(1)
  81. IGMN=MIN(IGAU,VELCHE(/1))
  82. IBMN=MIN(IB,VELCHE(/2))
  83. DIM3=VELCHE(IGMN,IBMN)
  84. ELSE
  85. DIM3=1.D0
  86. ENDIF
  87. ENDIF
  88. ENDIF
  89. *
  90. VNQSI1=0.D0
  91. VNQSI2=0.D0
  92. T1=0.D0
  93. T2=0.D0
  94. R=0.D0
  95. C
  96. C BOUCLE SUR LES NOEUDS
  97. C
  98. DO 20 I=1,NBNN
  99. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  100. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  101. R=R+SHPTOT(1,I,IGAU)*XE(1,I)
  102. 20 CONTINUE
  103. IF (IFOUR.LT.0) THEN
  104. R=1.D0
  105. ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  106. + .AND.NIFOUR.EQ.0)) THEN
  107. R=X2PI*R
  108. ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  109. R=XPI*R
  110. ENDIF
  111. IF (IFOUR.EQ.-2) R=R*DIM3
  112. *
  113. IF(IPTVPR.NE.0) THEN
  114. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  115. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  116. T1=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*(-VNQSI2)
  117. T2=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*VNQSI1
  118. ELSE
  119. T1=POIGAU(IGAU)*XP*R*(-VNQSI2)
  120. T2=POIGAU(IGAU)*XP*R*VNQSI1
  121. ENDIF
  122. C
  123. MPTVAL=IVAFOR
  124. DO 30 J=1,NBNN
  125. MELVAL=IVAL(1)
  126. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  127. MELVAL=IVAL(2)
  128. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  129. 30 CONTINUE
  130. C
  131. 10 CONTINUE
  132. 1 CONTINUE
  133. SEGSUP WORK
  134. END
  135.  
  136.  
  137.  

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