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

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