Télécharger ffdbit.eso

Retour à la liste

Numérotation des lignes :

ffdbit
  1. C FFDBIT SOURCE CB215821 20/11/25 13:28:50 10792
  2. SUBROUTINE FFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,IMPR)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C OPERATEUR DBIT
  8. C
  9. C CALCUL DU DEBIT D'UN VECTEUR A TRAVERS UNE SURFACE
  10. C SUR LE DOMAINE COURANT
  11. C
  12. C CALCUL EFFECTIF DU DEBIT.
  13. C
  14. C IZTUU : POINTEUR SUR LE CHPOINT-MPOVAL QUI DOIT ETRE DE TYPE VECT.
  15. C MELEME : POINTEUR SUR L'OBJET MAILLAGE
  16. C IZIPAD : Pointeur sur IPADL
  17. C QD : LE DEBIT
  18. C
  19. C
  20. C************************************************************************
  21.  
  22. PARAMETER (NLIS2=1,NLIS3=2)
  23. CHARACTER*8 LIST2(NLIS2),LIST3(NLIS3)
  24. CHARACTER*8 NOM0
  25. DIMENSION P2(2,2),P3(3,3),UI(3,9),UU(9)
  26. DIMENSION XN(3)
  27.  
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCGEOME
  32. -INC SMCOORD
  33. -INC SMCHPOI
  34. POINTEUR IZTUU.MPOVAL
  35. -INC SMELEME
  36. -INC SIZFFB
  37. -INC SMLENTI
  38.  
  39.  
  40. C***
  41. C
  42. DATA LIST2/'SEG2 '/
  43. DATA LIST3/'TRI3 ','QUA4 '/
  44. C
  45. C***
  46. C INITIALISATION
  47. C
  48. ULP = 0.
  49. ULM = 0.
  50. QD=0.
  51.  
  52. *
  53. * On peut y aller, les controles ont eu lieu dans DBIT
  54. *
  55. MLENTI=IZIPAD
  56. SEGACT IZTUU
  57. SEGACT MELEME
  58. NBSOUS=LISOUS(/1)
  59. IF(NBSOUS.EQ.0)NBSOUS=1
  60. DO 10 NS=1,NBSOUS
  61. IF(LISOUS(/1).EQ.0) IPT1 = MELEME
  62. IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS)
  63. SEGACT IPT1
  64. NBEL=IPT1.NUM(/2)
  65. NP=IPT1.NUM(/1)
  66. NOM0=NOMS(IPT1.ITYPEL)//' '
  67. IF(IDIM.EQ.2)CALL OPTLI(IP,LIST2,NOM0,1)
  68. IF(IDIM.EQ.3)CALL OPTLI(IP,LIST3,NOM0,2)
  69. IF(IP.EQ.0)WRITE(6,*)' CET ELEMENT :',NOM0,': NE CONVIENT PAS ',
  70. & 'POUR CALCULER UN DEBIT EN ',IDIM,' D'
  71. IF(IP.EQ.0)RETURN
  72.  
  73. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  74. IF(IZFFM.EQ.0)CALL ARRET(0)
  75. SEGACT IZFFM
  76. IZHR=KZHR(1)
  77. SEGACT IZHR*MOD
  78.  
  79. NPG=GR(/3)
  80. NES=GR(/1)
  81.  
  82. DO 20 K=1,NBEL
  83.  
  84. DO 11 I=1,NP
  85. J=IPT1.NUM(I,K)
  86. DO 19 N=1,IDIM
  87. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  88. J1=LECT(J)
  89. UI(N,I)=IZTUU.VPOCHA(J1,N)
  90. 19 CONTINUE
  91. 11 CONTINUE
  92.  
  93. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
  94.  
  95. IF(IDIM.EQ.3) THEN
  96.  
  97. CALL CALJQB(XYZ,P3,IDIM,NP)
  98. DO 13 I=1,NP
  99. UU(I)=UI(1,I)*P3(3,1)+UI(2,I)*P3(3,2)+UI(3,I)*P3(3,3)
  100. 13 CONTINUE
  101. DO 133 KS=1,IDIM
  102. XN(KS)= P3(3,KS)
  103. 133 CONTINUE
  104. ELSE
  105.  
  106. CALL CALJQB(XYZ,P2,IDIM,NP)
  107. DO 12 I=1,NP
  108. UU(I)=UI(1,I)*P2(2,1)+UI(2,I)*P2(2,2)
  109. 12 CONTINUE
  110. DO 122 KS=1,IDIM
  111. XN(KS)= P2(2,KS)
  112. 122 CONTINUE
  113.  
  114. ENDIF
  115.  
  116. UL=0.
  117. DO 14 I=1,NP
  118. DO 14 L=1,NPG
  119. UL=UL+UU(I)*FN(I,L)*PGSQ(L)
  120. 14 CONTINUE
  121.  
  122. IF(UL.GT.0.)THEN
  123. ULP = ULP+UL
  124. ELSE
  125. ULM = ULM+UL
  126. ENDIF
  127. QD=QD+UL
  128. 20 CONTINUE
  129. IF(LISOUS(/1).NE.0) SEGDES IPT1
  130. 10 CONTINUE
  131. SEGDES MELEME,IZTUU
  132. SEGSUP IZHR,IZFFM
  133.  
  134. IF(IMPR.NE.0)THEN
  135. WRITE(6,*)' DEBIT GLOBAL DANS LE SENS DE LA NORMALE = ',ULP
  136. WRITE(6,*)' DEBIT GLOBAL DANS LE SENS OPPOSE A LA NORMALE =',ULM
  137. ENDIF
  138. C******************************************************
  139.  
  140. RETURN
  141. END
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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