Télécharger kfdbit.eso

Retour à la liste

Numérotation des lignes :

  1. C KFDBIT SOURCE BP208322 16/11/18 21:18:11 9177
  2. SUBROUTINE KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,ULP,ULM,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.  
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCGEOME
  27. -INC SMCOORD
  28. -INC SMCHPOI
  29. POINTEUR IZTUU.MPOVAL
  30. -INC SMELEME
  31. -INC SIZFFB
  32. -INC SMLENTI
  33. -INC CCREEL
  34. CHARACTER*8 NOM0
  35. DIMENSION ULN(3)
  36. C***
  37. C
  38. C
  39. C***
  40. IAXI=0
  41. IF(IFOMOD.EQ.0)IAXI=1
  42. DEUPI=1.D0
  43. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  44.  
  45. ULP = 0.D0
  46. ULM = 0.D0
  47. QD=0.D0
  48.  
  49. *
  50. * On peut y aller, les controles ont eu lieu dans DBIT
  51. *
  52. MLENTI=IZIPAD
  53. SEGACT IZTUU
  54. SEGACT MELEME
  55. NBSOUS=LISOUS(/1)
  56. IF(NBSOUS.EQ.0)NBSOUS=1
  57. DO 10 NS=1,NBSOUS
  58. IPT1 = MELEME
  59. IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS)
  60. SEGACT IPT1
  61. NBEL=IPT1.NUM(/2)
  62. NP=IPT1.NUM(/1)
  63. NOM0=NOMS(IPT1.ITYPEL)//' '
  64.  
  65. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  66.  
  67. IF(IZFFM.EQ.0)THEN
  68. C% Type d'élément incorrect
  69. CALL ERREUR(16)
  70. RETURN
  71. ENDIF
  72.  
  73. SEGACT IZFFM*MOD
  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 19 N=1,IDIM
  83. DO 11 I=1,NP
  84. J=IPT1.NUM(I,K)
  85. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  86. 11 CONTINUE
  87. 19 CONTINUE
  88.  
  89. CALL CALJBR
  90. & (FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  91. C do 73964 ll=1,npg
  92. C write(6,*)'AJ'
  93. C write(6,1002)((aj(ii,jj,ll),ii=1,idim),jj=1,idim)
  94. C73964 continue
  95.  
  96. U=0.D0
  97. DO 14 L=1,NPG
  98. UNL=0.D0
  99. DO 12 N=1,IDIM
  100. ULN(N)=0.D0
  101. DO 13 I=1,NP
  102. I1=LECT(IPT1.NUM(I,K))
  103. ULN(N)=ULN(N)+FN(I,L)*IZTUU.VPOCHA(I1,N)
  104. 13 CONTINUE
  105. UNL=UNL+ULN(N)*AJ(N,IDIM,L)
  106. 12 CONTINUE
  107. U=U+UNL*PGSQ(L)*DEUPI*RPG(L)
  108. 14 CONTINUE
  109.  
  110.  
  111. IF(U.GT.0.D0)THEN
  112. ULP = ULP+U
  113. ELSE
  114. ULM = ULM+U
  115. ENDIF
  116. QD=QD+U
  117. 20 CONTINUE
  118. IF(LISOUS(/1).NE.0) SEGDES IPT1
  119. 10 CONTINUE
  120. SEGDES MELEME,IZTUU
  121. SEGSUP IZHR,IZFFM
  122.  
  123. IF(IMPR.NE.0)THEN
  124. WRITE(6,*)' DEBIT GLOBAL DANS LE SENS DE LA NORMALE = ',ULP
  125. WRITE(6,*)' DEBIT GLOBAL DANS LE SENS OPPOSE A LA NORMALE =',ULM
  126. write(6,*)' DEBIT TOTAL QD=',QD
  127. ENDIF
  128. C******************************************************
  129.  
  130. RETURN
  131. 1002 FORMAT(10(1X,1PE11.4))
  132. END
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  

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