Télécharger funcol.eso

Retour à la liste

Numérotation des lignes :

funcol
  1. C FUNCOL SOURCE CHAT 05/01/13 00:11:39 5004
  2. SUBROUTINE FUNCOL(NORDP1,RG,ACVTOG,ROG,TG,RTG,ETHEG,UG,GAMG,CG,
  3. & TGS,RTGS,CVGS,ROGS,PGS,ETHEGS,UGS,
  4. & DELSGS,UMXSOL,UPXSOL,
  5. & RC1,AEQ1,XSOL,
  6. & LOGEQ,DUDT,DPDT)
  7. C************************************************************************
  8. C
  9. C PROJET : CASTEM 2000
  10. C
  11. C NOM : FUNCOL
  12. C
  13. C DESCRIPTION : Calcul de l'etat choc (u-cg) et des certains
  14. C parametres utilises pour le calcul de dp/du
  15. C
  16. C LANGAGE : FORTRAN 77
  17. C
  18. C AUTEUR : A. BECCANTINI DRN/DMT/SEMT/LTMF
  19. C
  20. C************************************************************************
  21. C
  22. C APPELES : NONE
  23. C
  24. C************************************************************************
  25. C
  26. C
  27. C**** ENTREES:
  28. C
  29. C NORDP1 = degree des polynoms cv+1
  30. C RG = R du gaz a gauche
  31. C ACVTOT_j = \sum_{i=1,nesp} Y_i*ACV_{i,j}
  32. C ROG = masse volumique a gauche
  33. C TG = temperature a gauche
  34. C RTG = RG * TG = PG / ROG
  35. C ETHEG = energie thermique a gauche
  36. C UG = vitesse absolute a gauche
  37. C GAMG = CPG / CVG
  38. C CG = vitesse du son a gauche
  39. C TGS = temperature a droite
  40. C
  41. C**** SORTIES:
  42. C
  43. C RTGS = RG*TGS
  44. C CVGS = CV a droite
  45. C ROGS = masse volumique a droite
  46. C PGS = pression a droite
  47. C ETHEGS = energie thermique a droite
  48. C DELSGS,UMXSOL,UPXSOL,RC1,AEQ1,XSOL
  49. C = parameters pour determiner le jacobian
  50. C LOGEQ = logical: si .TRUE., TG = TGS et le jacobian
  51. C est stoke en DUDT,DPDT
  52. C
  53. C************************************************************************
  54. C
  55. C HISTORIQUE (Anomalies et modifications éventuelles)
  56. C
  57. C HISTORIQUE : Créé le 08.02.00
  58. C
  59. C************************************************************************
  60. C
  61. C N.B.: Toutes les variables sont DECLAREES
  62. C
  63. IMPLICIT INTEGER(I-N)
  64. INTEGER NORDP1,I1
  65. REAL*8 RG,ACVTOG(*),ROG,TG,RTG,ETHEG,UG,CG,GAMG
  66. & ,TGS,CVGS,ROGS,PGS,ETHEGS,UGS
  67. & ,RTGS,DELSGS,UMXSOL,UPXSOL,UMSUP,RC1
  68. & ,DPDU,DPDT,DUDT,VAL
  69. & ,FUNT,FUNCV,XSOL,AEQ2,AEQ1,SIGNUM
  70. LOGICAL LOGEQ
  71. C
  72. C**** Logeq = .TRUE. -> TGS = TG
  73. C On calcule aussi DPDT,DUDT
  74. C Pour l'etat on utilize le meme formules
  75. C que dans le cas LOGEQ = .FALSE.
  76. C
  77. LOGEQ = ABS(TGS - TG) .LE. (1.0D-2 * TG)
  78. C
  79. C**** Calcul de ETHEGS, CVGS
  80. C
  81. CVGS = ACVTOG(1)
  82. ETHEGS = TGS * CVGS
  83. FUNT = 1.0D0
  84. DO I1 = 2, NORDP1, 1
  85. FUNT = FUNT * TGS
  86. FUNCV = ACVTOG(I1) * FUNT
  87. CVGS = CVGS + FUNCV
  88. ETHEGS = ETHEGS + (FUNCV * TGS/ I1)
  89. ENDDO
  90. RTGS = RG * TGS
  91. C
  92. C**** XSOL = ROG / ROGS
  93. C XSOL t.c. RTG XSOL*XSOL + AEQ1 * XSOL - RTGS = 0
  94. C
  95. AEQ2 = RTG
  96. AEQ1 = 2.0D0 * (ETHEGS - ETHEG) + RTGS - AEQ2
  97. DELSGS = SQRT((AEQ1 * AEQ1) + (4.0D0 * RTGS * AEQ2))
  98. XSOL = (DELSGS - AEQ1) / (2.0D0 * AEQ2)
  99. ROGS = ROG / XSOL
  100. C
  101. C**** UGS, PGS
  102. C
  103. RC1 = AEQ1 + RTGS - AEQ2
  104. C
  105. C RC1 = 2.0D0*(HTHEGS - HTHEG)
  106. C
  107. C**** XSOL > 1 -> TG > TGS -> RC1 < 0
  108. C
  109. UMXSOL = 1.0D0 - XSOL
  110. SIGNUM = SIGN(1.0D0,UMXSOL)
  111. UPXSOL = 1.0D0 + XSOL
  112. UMSUP = UMXSOL / UPXSOL
  113. VAL = RC1 * UMSUP
  114. C
  115. C**** VAL > 0
  116. C
  117. VAL = SQRT(ABS(VAL))
  118. UGS = UG - SIGNUM*VAL
  119. PGS = RTGS * ROGS
  120. C
  121. C**** DUDT, DPDT
  122. C
  123. IF(LOGEQ)THEN
  124. DPDU = -1.0D0 * ROG * CG
  125. DPDT = (GAMG * PGS) / ((GAMG - 1.0D0) * TG)
  126. DUDT = DPDT / DPDU
  127. ELSE
  128. C
  129. C******* Initialisazion a zero (il sont calcules ailleur)
  130. C
  131. DPDT = 0.0D0
  132. DUDT = 0.0D0
  133. ENDIF
  134. C
  135. RETURN
  136. END
  137.  
  138.  
  139.  

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