Télécharger ffdbit.eso

Retour à la liste

Numérotation des lignes :

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

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