Télécharger fstiff.eso

Retour à la liste

Numérotation des lignes :

  1. C FSTIFF SOURCE BECC 11/05/26 21:15:28 6981
  2. SUBROUTINE FSTIFF(NDIM, NPAR,
  3. & PC_L, GAM_L,
  4. & PC_R, GAM_R,
  5. & PMIN,
  6. & RHO_L, P_L, U_L, UT1_L, UT2_L, W_L,
  7. & RHO_R, P_R, U_R, UT1_R, UT2_R, W_R,
  8. & RHO_B, P_B, U_B, D_B,
  9. & RHO_A, P_A, U_A, D_A,
  10. & Z,
  11. & UINT,
  12. & F_LAG, CELLT,
  13. & LOGAN, LOGNC, LOGVAC)
  14. *
  15. *************************************************************************
  16. *
  17. * project : CAST3M, Europlexus...
  18. *
  19. * name : fstiff
  20. *
  21. * description : stiffened gas mixture.
  22. *
  23. * language : fortran 77
  24. *
  25. * author : a. beccantini den/dm2s/sfme/ltmf
  26. *
  27. *************************************************************************
  28. *
  29. * called sub :
  30. *
  31. * called by :
  32. *
  33. *************************************************************************
  34. *
  35. ***** input
  36. *
  37. * ndim = dimension (1, 2 or 3)
  38. *
  39. * npar = number of parameters involved in the
  40. * equations
  41. *
  42. * pc_, gam_ = parameters involved in the eos
  43. *
  44. * rho_, p_, u_, ut1_, ut2_, w_,
  45. * = density, pressure, normal and tangential
  46. * velocities, parameter vector
  47. * nb dim(w_) = npar
  48. *
  49. * z = value of the characteristic variable x/t in
  50. * which we want to evaluate the flux f_lag
  51. *
  52. ***** output
  53. *
  54. * uint = speed of the contact discontinuity
  55. *
  56. * f_lag = ale interfacial flux in (n,t1,t2), i.e.
  57. * rho*(un - x/t) mass
  58. * rho*(un - x/t)*un + p momentum along n
  59. * rho*(un - x/t)*ut1 momentum along t1
  60. * rho*(un - x/t)*ut2 momentum along t2
  61. * rho*(un - x/t)*ht energy
  62. * rho*(un - x/t)*w(1) parameter 1
  63. * ...
  64. *
  65. * nb
  66. * according to nkonga, comput methods appl. mech engnr 190, 2000
  67. * \dep{u}{x} + \dep{f(u)}{x} = 0
  68. * z = speed of the surface
  69. * f_z = f - z u
  70. *
  71. *
  72. * cellt = stability condition, i.e.
  73. *
  74. * dt/dx < cellt (dimension 1/velocity)
  75. *
  76. * logan = if true, anomaly detected
  77. *
  78. * lognc = if true, the Newton for the Riemann problem
  79. * solution did not converge
  80. *
  81. *************************************************************************
  82. *
  83. * 02/12/2009 created
  84. * 25/05/2011 evolution in CAST3M
  85. *
  86. *************************************************************************
  87. *
  88. * n.b.: all variables are declared
  89. *
  90. C IMPLICIT NONE
  91. IMPLICIT INTEGER(I-N)
  92. INTEGER NDIM, NPAR, IPAR
  93. REAL*8 PMIN
  94. REAL*8 PC_L, GAM_L, PC_R, GAM_R, Z
  95. & , RHO_L, P_L, U_L, UT1_L, UT2_L, W_L(NPAR)
  96. & , RHO_R, P_R, U_R, UT1_R, UT2_R, W_R(NPAR)
  97. & , F_LAG(NDIM + 3 + NPAR)
  98. & , CELLT
  99. & , D_L, D_B, D_A, D_R, RHO_B, P_B, U_B
  100. & , RHO_A, P_A, U_A
  101. & , FLURHO, FLURU, FLURT1, FLURT2, FLURET, COEF
  102. & , UINT
  103. LOGICAL LOGAN, LOGDEB, LOGNC, LOGVAC
  104. PARAMETER (LOGDEB = .FALSE.)
  105. *
  106. *************************************************************************
  107. ******** field-by-field decomposition ***********************************
  108. *************************************************************************
  109. *
  110. CALL RACSTI(
  111. & PC_L, GAM_L,
  112. & PC_R, GAM_R,
  113. & PMIN,
  114. & RHO_L, P_L, U_L,
  115. & RHO_R, P_R, U_R,
  116. & D_L, D_B, D_A, D_R,
  117. & RHO_B, P_B, U_B,
  118. & RHO_A, P_A, U_A,
  119. & LOGDEB, LOGAN, LOGNC, LOGVAC)
  120. *
  121. IF (LOGDEB .OR. LOGNC) THEN
  122. * IF (LOGDEB .OR. LOGNC .OR. LOGVAC) THEN
  123. WRITE(*,*)
  124. WRITE(*,*) 'RHO_L, P_L, U_L, D_L'
  125. WRITE(*,*) RHO_L, P_L, U_L, D_L
  126. WRITE(*,*) 'RHO_B, P_B, U_B, D_B'
  127. WRITE(*,*) RHO_B, P_B, U_B, D_B
  128. WRITE(*,*) 'RHO_A, P_A, U_A, D_A'
  129. WRITE(*,*) RHO_A, P_A, U_A, D_A
  130. WRITE(*,*) 'RHO_R, P_R, U_R, D_R'
  131. WRITE(*,*) RHO_R, P_R, U_R, D_R
  132. WRITE(*,*)
  133. ENDIF
  134. IF (LOGAN) THEN
  135. WRITE(*,*) 'SUBROUTINE FSTIFF.F'
  136. WRITE(*,*) 'ANOMALY DETECTED'
  137. GOTO 9999
  138. ENDIF
  139. *
  140. *************************************************************************
  141. ******** flux ***********************************************************
  142. *************************************************************************
  143. *
  144. CALL FLUSTI(
  145. & PC_L, GAM_L,
  146. & PC_R, GAM_R,
  147. & Z,
  148. & D_L, D_B, D_A, D_R,
  149. & RHO_L, P_L, U_L, UT1_L, UT2_L,
  150. & RHO_B, P_B, U_B,
  151. & RHO_A, P_A, U_A,
  152. & RHO_R, P_R, U_R, UT1_R, UT2_R,
  153. & UINT,
  154. & FLURHO, FLURU, FLURT1, FLURT2, FLURET,
  155. & LOGDEB, LOGAN)
  156. IF (LOGDEB) THEN
  157. C IF (LOGVAC) THEN
  158. WRITE(*,*)
  159. WRITE(*,*) 'FLURHO, FLURU, FLURT1, FLURT2, FLURET'
  160. WRITE(*,*) FLURHO, FLURU, FLURT1, FLURT2, FLURET
  161. WRITE(*,*)
  162. stop
  163. ENDIF
  164. IF (LOGAN) THEN
  165. WRITE(*,*) 'SUBROUTINE FSTIFF.F'
  166. WRITE(*,*) 'ANOMALY DETECTED'
  167. GOTO 9999
  168. ENDIF
  169. *
  170. ***** condition for the cfl
  171. *
  172. CELLT = MAX (ABS(D_L), ABS(D_R))
  173. *
  174. F_LAG(1) = FLURHO
  175. F_LAG(2) = FLURU
  176. F_LAG(3) = FLURT1
  177. IF (NDIM .EQ. 3) THEN
  178. * nb if ndim = 1 and npar = 0, index 4 does not
  179. * exist
  180. F_LAG(4) = FLURT2
  181. ENDIF
  182. F_LAG(2 + NDIM) = FLURET
  183. COEF = 1.0D0
  184. IF (FLURHO .LT. 0) THEN
  185. COEF = -1.0D0
  186. ENDIF
  187. *
  188. DO IPAR = 1, NPAR, 1
  189. F_LAG(2 + NDIM + IPAR) = 0.5D0 * FLURHO * (
  190. & ((COEF + 1.0D0) * W_L(IPAR)) +
  191. & ((1.0D0 - COEF) * W_R(IPAR))
  192. & )
  193. ENDDO
  194. 9999 CONTINUE
  195. RETURN
  196. END
  197.  
  198.  
  199.  

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