Télécharger fpeltu.eso

Retour à la liste

Numérotation des lignes :

  1. C FPELTU SOURCE CB215821 19/08/20 21:17:50 10287
  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.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMCHAML
  33.  
  34. SEGMENT MPTVAL
  35. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  36. CHARACTER*16 TYVAL(NCOSOU)
  37. ENDSEGMENT
  38.  
  39. DIMENSION XFORC(12),WORK(12),VECT(3)
  40. DIMENSION XE(3,2),P(3,3),XX(2),YY(2),ZZ(2)
  41.  
  42. MELEME=IPMAIL
  43. NBELEM=NUM(/2)
  44.  
  45. C= BOUCLE SUR LES ELEMENTS
  46. DO 103 IB=1,NBELEM
  47. C
  48. CALL DOXE(XCOOR,3,2,NUM,IB,XE)
  49. DO 105 J=1,2
  50. XX(J)=XE(1,J)
  51. YY(J)=XE(2,J)
  52. ZZ(J)=XE(3,J)
  53. 105 CONTINUE
  54. C
  55. XLON2=(XX(2)-XX(1))**2+(YY(2)-YY(1))**2+(ZZ(2)-ZZ(1))**2
  56. XLON=SQRT(XLON2)
  57. IF (XLON.NE.0.D0) GOTO 106
  58. C
  59. INTERR(1)=ISOUS
  60. INTERR(2)=IB
  61. CALL ERREUR(128)
  62. RETURN
  63. C
  64. 106 CONTINUE
  65. C
  66. C ON CHERCHE LES CARACTERISTIQUES
  67. C
  68. CALL ZERO(XFORC,1,12)
  69. MPTVAL=IVACAR
  70. NBCAR=IVAL(/1)
  71. C
  72. MELVAL=IVAL(1)
  73. IBMN=MIN(IB,VELCHE(/2))
  74. EPAI=VELCHE(1,IBMN)
  75. C
  76. MELVAL=IVAL(2)
  77. REXT=VELCHE(1,IBMN)
  78. C
  79. IF (IPTVPR.EQ.0) THEN
  80. MELVAL=IVAL(3)
  81. ELSE
  82. MELVAL=IPTVPR
  83. ENDIF
  84. PRES=VELCHE(1,IBMN)
  85. C
  86. IF (IVAL((NBCAR-1)).NE.0) THEN
  87. MELVAL=IVAL((NBCAR-1))
  88. RACO=VELCHE(1,IBMN)
  89. ELSE
  90. RACO=0.
  91. ENDIF
  92. C
  93. IF (IVAL(NBCAR).NE.0) THEN
  94. MELVAL=IVAL(NBCAR)
  95. IBMN=MIN(IB,IELCHE(/2))
  96. IP=IELCHE(1,IBMN)
  97. IREF=(IP-1)*(IDIM+1)
  98. DO 6129 IC=1,3
  99. VECT(IC)=XCOOR(IREF+IC)
  100. 6129 CONTINUE
  101. ELSE
  102. DO 6229 IC=1,3
  103. VECT(IC)=0.
  104. 6229 CONTINUE
  105. ENDIF
  106. C
  107. RINT=REXT-EPAI
  108. FL=XPI*PRES*RINT**2
  109. IF (RACO.NE.0.D0) THEN
  110. FL=FL/SQRT(1.D0-0.25D0*XLON2/RACO**2)
  111. ENDIF
  112. CALL ZERO(WORK,1,12)
  113. WORK(1)=-FL
  114. WORK(7)=FL
  115. C
  116. CALL POUPAS(XX,YY,ZZ,VECT,P,KERRE)
  117. IF (KERRE.EQ.0) GOTO 107
  118. C
  119. INTERR(1)=ISOUS
  120. INTERR(2)=IB
  121. CALL ERREUR(138)
  122. RETURN
  123. C
  124. 107 CONTINUE
  125. CALL POUVEC(WORK,XFORC,P,2)
  126. IE=0
  127. C
  128. C REMPLISSAGE DU SEGMENT CONTENANT LES FORCES
  129. C
  130. MPTVAL=IVAFOR
  131. DO 104 IGAU=1,2
  132. DO 104 ICOMP=1,6
  133. MELVAL=IVAL(ICOMP)
  134. IGMN=MIN(IGAU,VELCHE(/1))
  135. IBMN=MIN(IB ,VELCHE(/2))
  136. IE=IE+1
  137. VELCHE(IGMN,IBMN)=XFORC(IE)
  138. 104 CONTINUE
  139. C
  140. 103 CONTINUE
  141.  
  142. END
  143.  
  144.  
  145.  

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