Télécharger fpeltu.eso

Retour à la liste

Numérotation des lignes :

  1. C FPELTU SOURCE MB234859 16/12/14 21:15:09 9253
  2. C_______________________________________________________________________
  3. C
  4. C CALCUL DES FORCES DE PRESSION POUR LES ELEMENTS TUYAU
  5. C
  6. C ENTREES:
  7. C ________
  8. C
  9. C IPTVPR Pointeur sur un MELVAL contenant les pressions appliquees
  10. C IVACAR Pointeur sur un MCHAML de CARACTERISTIQUES
  11. C IPMAIL Pointeur sur un MELEME
  12. C ISOUS Entier indiquant la zone elementaire traitee
  13. C (info necessaire dans l'affichage des erreurs 128 et 138)
  14. C
  15. C SORTIES:
  16. C ________
  17. C
  18. C IVAFOR Pointeur sur un MPTVAL de forces aux noeuds
  19. C_______________________________________________________________________
  20. C
  21. SUBROUTINE FPELTU(IPTVPR,IVACAR,IPMAIL,ISOUS,IVAFOR)
  22.  
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC CCOPTIO
  27. -INC CCREEL
  28. -INC SMCOORD
  29. -INC SMELEME
  30. -INC SMCHAML
  31.  
  32. SEGMENT MPTVAL
  33. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  34. CHARACTER*16 TYVAL(NCOSOU)
  35. ENDSEGMENT
  36.  
  37. DIMENSION XFORC(12),WORK(12),VECT(3)
  38. DIMENSION XE(3,2),P(3,3),XX(2),YY(2),ZZ(2)
  39.  
  40. MELEME=IPMAIL
  41. NBELEM=NUM(/2)
  42.  
  43. C= BOUCLE SUR LES ELEMENTS
  44. DO 103 IB=1,NBELEM
  45. C
  46. CALL DOXE(XCOOR,3,2,NUM,IB,XE)
  47. DO 105 J=1,2
  48. XX(J)=XE(1,J)
  49. YY(J)=XE(2,J)
  50. ZZ(J)=XE(3,J)
  51. 105 CONTINUE
  52. C
  53. XLON2=(XX(2)-XX(1))**2+(YY(2)-YY(1))**2+(ZZ(2)-ZZ(1))**2
  54. XLON=SQRT(XLON2)
  55. IF (XLON.NE.0.D0) GOTO 106
  56. C
  57. INTERR(1)=ISOUS
  58. INTERR(2)=IB
  59. CALL ERREUR(128)
  60. RETURN
  61. C
  62. 106 CONTINUE
  63. C
  64. C ON CHERCHE LES CARACTERISTIQUES
  65. C
  66. CALL ZERO(XFORC,1,12)
  67. MPTVAL=IVACAR
  68. NBCAR=IVAL(/1)
  69. C
  70. MELVAL=IVAL(1)
  71. IBMN=MIN(IB,VELCHE(/2))
  72. EPAI=VELCHE(1,IBMN)
  73. C
  74. MELVAL=IVAL(2)
  75. REXT=VELCHE(1,IBMN)
  76. C
  77. IF (IPTVPR.EQ.0) THEN
  78. MELVAL=IVAL(3)
  79. ELSE
  80. MELVAL=IPTVPR
  81. ENDIF
  82. PRES=VELCHE(1,IBMN)
  83. C
  84. IF (IVAL((NBCAR-1)).NE.0) THEN
  85. MELVAL=IVAL((NBCAR-1))
  86. RACO=VELCHE(1,IBMN)
  87. ELSE
  88. RACO=0.
  89. ENDIF
  90. C
  91. IF (IVAL(NBCAR).NE.0) THEN
  92. MELVAL=IVAL(NBCAR)
  93. IBMN=MIN(IB,IELCHE(/2))
  94. IP=IELCHE(1,IBMN)
  95. IREF=(IP-1)*(IDIM+1)
  96. DO 6129 IC=1,3
  97. VECT(IC)=XCOOR(IREF+IC)
  98. 6129 CONTINUE
  99. ELSE
  100. DO 6229 IC=1,3
  101. VECT(IC)=0.
  102. 6229 CONTINUE
  103. ENDIF
  104. C
  105. RINT=REXT-EPAI
  106. FL=XPI*PRES*RINT**2
  107. IF (RACO.NE.0.D0) THEN
  108. FL=FL/SQRT(1.D0-0.25D0*XLON2/RACO**2)
  109. ENDIF
  110. CALL ZERO(WORK,1,12)
  111. WORK(1)=-FL
  112. WORK(7)=FL
  113. C
  114. CALL POUPAS(XX,YY,ZZ,VECT,P,KERRE)
  115. IF (KERRE.EQ.0) GOTO 107
  116. C
  117. INTERR(1)=ISOUS
  118. INTERR(2)=IB
  119. CALL ERREUR(138)
  120. RETURN
  121. C
  122. 107 CONTINUE
  123. CALL POUVEC(WORK,XFORC,P,2)
  124. IE=0
  125. C
  126. C REMPLISSAGE DU SEGMENT CONTENANT LES FORCES
  127. C
  128. MPTVAL=IVAFOR
  129. DO 104 IGAU=1,2
  130. DO 104 ICOMP=1,6
  131. MELVAL=IVAL(ICOMP)
  132. IGMN=MIN(IGAU,VELCHE(/1))
  133. IBMN=MIN(IB ,VELCHE(/2))
  134. IE=IE+1
  135. VELCHE(IGMN,IBMN)=XFORC(IE)
  136. 104 CONTINUE
  137. C
  138. 103 CONTINUE
  139.  
  140. SEGDES,MELVAL
  141.  
  142. RETURN
  143. END
  144.  
  145.  
  146.  
  147.  

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