Télécharger fde23d.eso

Retour à la liste

Numérotation des lignes :

  1. C FDE23D SOURCE BP208322 16/11/18 21:17:02 9177
  2. SUBROUTINE FDE23D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IELI)
  3. C_______________________________________________________________________
  4. C
  5. C CALCULE LES FORCES DE DEBITS SUR LES FACES D ELEMENTS
  6. C MASSIFS ( INSPIRE DE FPMA2D ET FPMA3D )
  7. C
  8. C ENTREES :
  9. C ---------
  10. C
  11. C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  12. C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  13. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  14. C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES
  15. C NODALES RESUL
  16. C IELI NUMERO DU TYPE D'E.F. LINEAIRE ASSOCIE
  17. C
  18. C Passage aux nouveaux CHAMELEM par JM CAMPENON le 06/91
  19. C_______________________________________________________________________
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. C
  24. -INC SMCHAML
  25. -INC SMELEME
  26. -INC SMINTE
  27. -INC SMCOORD
  28. -INC CCOPTIO
  29. -INC CCGEOME
  30. C
  31. SEGMENT SHXX
  32. REAL*8 SHPXXX(6,NBBB)
  33. ENDSEGMENT
  34. C
  35. SEGMENT WORK
  36. REAL*8 XE(3,NBPTE1)
  37. ENDSEGMENT
  38. C
  39. MELVAL=IVAFOR
  40. C
  41. MELVA1=IPTVPR
  42. SEGACT MELVA1
  43. NBPTE1=MELVA1.VELCHE(/1)
  44. NEL1 =MELVA1.VELCHE(/2)
  45. C
  46. MINTE=IPTINT
  47. SEGACT MINTE
  48. NBPGAU=POIGAU(/1)
  49. C
  50. MELEME=IPMAIL
  51. SEGACT MELEME
  52. NBPTE1=NUM(/1)
  53. NEL =NUM(/2)
  54. NBBB=NBNNE(IELI)
  55. C
  56. NBPTEL=NBBB
  57. SEGINI SHXX
  58. SEGINI WORK
  59. C
  60. C BOUCLE SUR LES ELEMENTS
  61. C
  62. DO 1 IB=1,NEL
  63. CALL DOXE(XCOOR,IDIM,NBPTE1,NUM,IB,XE)
  64. C
  65. C BOUCLE SUR LES POINTS DE GAUSS
  66. C
  67. IF(IDIM.EQ.3) THEN
  68. C
  69. C CAS TRIDIM
  70. C
  71. DO 10 K=1,NBPGAU
  72. DXDQSI=0.D0
  73. DXDETA=0.D0
  74. DYDQSI=0.D0
  75. DYDETA=0.D0
  76. C
  77. C BOUCLE SUR TOUS LES NOEUDS
  78. C
  79. DO 20 I=1,NBPTE1
  80. DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  81. DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  82. DXDETA=DXDETA+SHPTOT(3,I,K)*XE(1,I)
  83. DYDETA=DYDETA+SHPTOT(3,I,K)*XE(2,I)
  84. 20 CONTINUE
  85. DJAC=DXDQSI*DYDETA-DXDETA*DYDQSI
  86. C
  87. KMIN =MIN(K,NBPTE1)
  88. IBMIN=MIN(IB,NEL1)
  89. TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*DJAC
  90. C
  91. C ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  92. C
  93. XX=QSIGAU(K)
  94. YY=ETAGAU(K)
  95. ZZ=DZEGAU(K)
  96. CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  97. C
  98. C BOUCLE SUR LES SOMMETS UNIQUEMENT
  99. C
  100. DO 30 J=1,NBBB
  101. VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  102. 30 CONTINUE
  103. 10 CONTINUE
  104. ELSE IF (IDIM.EQ.2) THEN
  105. C
  106. C CAS BIDIM
  107. C
  108. DO 110 K=1,NBPGAU
  109. DXDQSI=0.D0
  110. DYDQSI=0.D0
  111. R=0.D0
  112. C
  113. C BOUCLE SUR TOUS LES NOEUDS
  114. C
  115. DO 120 I=1,NBPTE1
  116. DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  117. DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  118. R=R+SHPTOT(1,I,K)*XE(1,I)
  119. 120 CONTINUE
  120. IF (IFOUR.LT.0) R=1.D0
  121. DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI)
  122. KMIN=MIN(K,NBPTE1)
  123. IBMIN=MIN(IB,NEL1)
  124. TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*R*DJAC
  125. C
  126. C ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  127. C
  128. XX=QSIGAU(K)
  129. YY=ETAGAU(K)
  130. ZZ=0.
  131. CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  132. C
  133. C BOUCLE SUR LES SOMMETS UNIQUEMENT
  134. C
  135. DO 130 J=1,NBBB
  136. VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  137. 130 CONTINUE
  138. C
  139. 110 CONTINUE
  140. ENDIF
  141. C
  142. 1 CONTINUE
  143. SEGSUP SHXX
  144. SEGSUP WORK
  145. SEGDES MELVA1,MELEME,MINTE
  146. SEGDES MELVAL
  147. RETURN
  148. END
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

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