Télécharger fpma1d.eso

Retour à la liste

Numérotation des lignes :

  1. C FPMA1D SOURCE FANDEUR 10/08/31 21:17:10 6734
  2.  
  3. C=======================================================================
  4. C= Calcul des forces de pressions s'exercant sur les faces d elements =
  5. C= massifs unidimensionnels (1D) =
  6. C= =
  7. C= IPTVPR Pointeur sur un MELVAL contenant les pressions appliquees =
  8. C= =0 si on a donne une valeur constante =
  9. C= IPMAIL Pointeur sur un MELEME de l'ENVELOPPE =
  10. C= IPTINT Pointeur sur un MINTE des caracteristiques d'integration =
  11. C= (ACTIF en ENTREE et en SORTIE sans modification) =
  12. C= IVAFOR Pointeur sur un MPTVAL (MELVAL) contenant les forces =
  13. C= nodales equivalentes =
  14. C= XP Valeur de la pression si constante =
  15. C=======================================================================
  16.  
  17. SUBROUTINE FPMA1D (IPTVPR,IPMAIL,IPTINT,IVAFOR,XP)
  18.  
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22. -INC CCOPTIO
  23. -INC CCREEL
  24. -INC SMCHAML
  25. -INC SMELEME
  26. -INC SMINTE
  27. -INC SMCOORD
  28.  
  29. SEGMENT WORK
  30. REAL*8 XE(3,NBNN)
  31. ENDSEGMENT
  32.  
  33. SEGMENT MPTVAL
  34. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  35. CHARACTER*16 TYVAL(NCOSOU)
  36. ENDSEGMENT
  37.  
  38. C= Quelques constantes (2.Pi et 4.Pi)
  39. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  40. PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  41.  
  42. IF (IPTVPR.NE.0) THEN
  43. MELVA1=IPTVPR
  44. SEGACT,MELVA1
  45. IVA12=MELVA1.VELCHE(/2)
  46. ENDIF
  47.  
  48. MINTE=IPTINT
  49. C* SEGACT,MINTE <- ACTIF en E/S
  50. NBPGAU=POIGAU(/1)
  51.  
  52. MELEME=IPMAIL
  53. SEGACT,MELEME
  54. NBNN=NUM(/1)
  55. NBELEM=NUM(/2)
  56.  
  57. C*OF IF ((NBPGAU.NE.1).OR.(NBNN.NE.1)) THEN
  58. C*OF WRITE(6,*) 'ERREUR FATALE : FPMA1D'
  59. C*OF RETURN
  60. C*OF ENDIF
  61.  
  62. SEGINI,WORK
  63.  
  64. MPTVAL=IVAFOR
  65. MELVAL=IVAL(1)
  66. C= BOUCLE SUR LES ELEMENTS
  67. DO iElt=1,NBELEM
  68. CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  69. C= Cas des elements AXISymetriques et SPHEriques
  70. IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  71. T1=X2Pi*XE(1,1)
  72. ELSE IF (IFOUR.EQ.15) THEN
  73. RR=XE(1,1)
  74. T1=X4Pi*RR*RR
  75. ELSE
  76. T1=1.
  77. ENDIF
  78. IF (IPTVPR.NE.0) THEN
  79. IEMN=MIN(iElt,IVA12)
  80. T1=MELVA1.VELCHE(1,IEMN)*T1
  81. ELSE
  82. T1=XP*T1
  83. ENDIF
  84. VELCHE(1,iElt)=VELCHE(1,iElt)+T1
  85. ENDDO
  86.  
  87. SEGSUP,WORK
  88.  
  89. C* SEGDES,MINTE <- ACTIF en E/S
  90. SEGDES,MELEME
  91. IF (IPTVPR.NE.0) SEGDES,MELVA1
  92.  
  93. RETURN
  94. END
  95.  
  96.  
  97.  

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