Télécharger rdemup.eso

Retour à la liste

Numérotation des lignes :

  1. C RDEMUP SOURCE BECC 11/01/05 21:15:21 6836
  2. SUBROUTINE RDEMUP(IDIM, NPAR,
  3. & SCON1, SG1, SD1,
  4. & SCON2, SG2, SD2,
  5. & SURF,VOLG,VOLD,
  6. & CNX,CNY,CNZ,CTX,CTY,CTZ,CT1X,CT1Y,CT1Z,
  7. & FLU,FLULAG,RESG,RESD)
  8. C************************************************************************
  9. C
  10. C PROJET : CASTEM 2000
  11. C
  12. C NOM : RDEMUP
  13. C
  14. C DESCRIPTION : Voir KODFL1
  15. C Update of the residual in RDEM
  16. C Cas deux/trois dimensions
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C Crée le 11.06.2010
  27. C Estension au 3D le 21.12.2010
  28. C
  29. *
  30. * --- variables globales
  31. *
  32. IMPLICIT INTEGER(I-N)
  33. INTEGER IDIM, NPAR, ICOMP
  34. REAL*8 SCON1, SG1, SD1,
  35. & SCON2, SG2, SD2,
  36. & SURF, VOLG, VOLD, CNX,CNY,CNZ,
  37. & CTX, CTY, CTZ, CT1X, CT1Y, CT1Z,
  38. & FLU(*),FLULAG(*), RESG(*),RESD(*),
  39. & FG(3),FD(3)
  40. C
  41. C
  42. C do icomp = 1, (idim + 3)
  43. C write(*,*) icomp, flu(icomp), flulag(icomp)
  44. C enddo
  45. C
  46. C PHASE 1
  47. C
  48. C alpha1
  49. C
  50. FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD1
  51. FG(1) = FLULAG(IDIM + 3) * SG1
  52. RESD(1) = (FD(1) * SURF / VOLD)
  53. RESG(1) = -1.0D0 * (FG(1) * SURF / VOLG)
  54. C
  55. C rho1 alpha1
  56. C
  57. FG(1) = FLU(1) * SCON1 + FLULAG(1) * SG1
  58. FD(1) = FLU(1) * SCON1 - FLULAG(1) * SD1
  59. RESG(2) = -1.D0 * (FG(1) * SURF / VOLG)
  60. RESD(2) = (FD(1) * SURF / VOLD)
  61. C
  62. C rho1 alpha1 ux1, uy1, uz1
  63. C
  64. FD(1) = (FLU(2) * CNX) *
  65. & SCON1 -
  66. & (FLULAG(2) * CNX)
  67. $ * SD1
  68. FG(1) = (FLU(2) * CNX) *
  69. & SCON1 +
  70. & (FLULAG(2) * CNX)
  71. $ * SG1
  72. IF (IDIM .GE. 2) THEN
  73. FD(1) = FD(1) +
  74. & ((FLU(3) * CTX) *
  75. & SCON1 -
  76. & (FLULAG(3) * CTX)
  77. $ * SD1)
  78. FG(1) = FG(1) +
  79. & ((FLU(3) * CTX) *
  80. & SCON1 +
  81. & (FLULAG(3) * CTX)
  82. $ * SG1)
  83. FD(2) = (FLU(2) * CNY + FLU(3) * CTY)
  84. & * SCON1 -
  85. & (FLULAG(2) * CNY + FLULAG(3) * CTY)
  86. & * SD1
  87. FG(2) = (FLU(2) * CNY + FLU(3) * CTY)
  88. & * SCON1 +
  89. & (FLULAG(2) * CNY + FLULAG(3) * CTY)
  90. & * SG1
  91. ENDIF
  92. IF (IDIM .EQ. 3) THEN
  93. FD(1) = FD(1) +
  94. & ((FLU(4) * CT1X) *
  95. & SCON1 -
  96. & (FLULAG(4) * CT1X)
  97. $ * SD1)
  98. FG(1) = FG(1) +
  99. & ((FLU(4) * CT1X) *
  100. & SCON1 +
  101. & (FLULAG(4) * CT1X)
  102. $ * SG1)
  103. FD(2) = FD(2) +
  104. & ((FLU(4) * CT1Y)
  105. & * SCON1 -
  106. & (FLULAG(4) * CT1Y)
  107. & * SD1)
  108. FG(2) = FG(2) +
  109. & ((FLU(4)* CT1Y)
  110. & * SCON1 +
  111. & (FLULAG(4) * CT1Y)
  112. & * SG1)
  113. FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
  114. & * SCON1 -
  115. & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
  116. & * SD1
  117. FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
  118. & * SCON1 +
  119. & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
  120. & * SG1
  121. ENDIF
  122. C
  123. C write(*,*) 'Flux on momentum, 1'
  124. C write(*,*) fg(1), fd(1)
  125. C write(*,*) fg(2), fd(2)
  126. C if (idim .eq. 3) write(*,*) fg(3), fd(3)
  127. C
  128. DO ICOMP = 1, IDIM, 1
  129. RESG(2 + ICOMP) = -1.D0 * (FG(ICOMP) * SURF / VOLG)
  130. RESD(2 + ICOMP) = (FD(ICOMP) * SURF / VOLD)
  131. ENDDO
  132. C
  133. C rho1 alpha1 et1
  134. C
  135. FG(1) = FLU(2 + IDIM) * SCON1 + FLULAG(2 + IDIM) * SG1
  136. FD(1) = FLU(2 + IDIM) * SCON1 - FLULAG(2 + IDIM) * SD1
  137. RESG(3 + IDIM) = -1.0D0 * (FG(1) * SURF / VOLG)
  138. RESD(3 + IDIM) = (FD(1) * SURF / VOLD)
  139. C
  140. DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1
  141. FG(1) = FLU(ICOMP) * SCON1 + FLULAG(ICOMP) * SG1
  142. FD(1) = FLU(ICOMP) * SCON1 - FLULAG(ICOMP) * SD1
  143. RESG(ICOMP) = -1.0D0 * (FG(1) * SURF / VOLG)
  144. RESD(ICOMP) = (FD(1) * SURF / VOLD)
  145. ENDDO
  146. C
  147. C
  148. C PHASE 2.
  149. C
  150. C alpha2
  151. C
  152. FG(1) = FLULAG(IDIM + 3) * SG2
  153. FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD2
  154. RESD(4 + IDIM + NPAR) = (FD(1) * SURF / VOLD)
  155. RESG(4 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
  156. C
  157. C alpha2 rho2
  158. C
  159. FG(1) = FLU(1) * SCON2 + FLULAG(1) * SG2
  160. FD(1) = FLU(1) * SCON2 - FLULAG(1) * SD2
  161. RESD(5 + IDIM + NPAR) = (FD(1) * SURF / VOLD)
  162. RESG(5 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
  163. C
  164. C alpha2 rho2 ux uy uz
  165. C
  166. FD(1) = (FLU(2) * CNX) *
  167. & SCON2 -
  168. & (FLULAG(2) * CNX)
  169. $ * SD2
  170. FG(1) = (FLU(2) * CNX) *
  171. & SCON2 +
  172. & (FLULAG(2) * CNX)
  173. $ * SG2
  174. IF (IDIM .GE. 2) THEN
  175. FD(1) = FD(1) +
  176. & ((FLU(3) * CTX) *
  177. & SCON2 -
  178. & (FLULAG(3) * CTX)
  179. $ * SD2)
  180. FG(1) = FG(1) +
  181. & ((FLU(3) * CTX) *
  182. & SCON2 +
  183. & (FLULAG(3) * CTX)
  184. $ * SG2)
  185. FG(2) = (FLU(2) * CNY + FLU(3) * CTY)
  186. & * SCON2 +
  187. & (FLULAG(2) * CNY + FLULAG(3) * CTY)
  188. & * SG2
  189. FD(2) = (FLU(2) * CNY + FLU(3) * CTY)
  190. & * SCON2 -
  191. & (FLULAG(2) * CNY + FLULAG(3) * CTY)
  192. & * SD2
  193. ENDIF
  194. IF (IDIM .EQ. 3) THEN
  195. FD(1) = FD(1) +
  196. & ((FLU(4) * CT1X) *
  197. & SCON2 -
  198. & (FLULAG(4) * CT1X)
  199. $ * SD2)
  200. FG(1) = FG(1) +
  201. & ((FLU(4) * CT1X) *
  202. & SCON2 +
  203. & (FLULAG(4) * CT1X)
  204. $ * SG2)
  205. FG(2) = FG(2) +
  206. & ((FLU(4) * CT1Y)
  207. & * SCON2 +
  208. & (FLULAG(4) * CT1Y)
  209. & * SG2)
  210. FD(2) = FD(2) +
  211. & ((FLU(4) * CT1Y)
  212. & * SCON2 -
  213. & (FLULAG(4) * CT1Y)
  214. & * SD2)
  215. FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
  216. & * SCON2 +
  217. & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
  218. & * SG2
  219. FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
  220. & * SCON2 -
  221. & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
  222. & * SD2
  223. ENDIF
  224. C
  225. C write(*,*) 'Flux on momentum, 2'
  226. C write(*,*) fg(1), fd(1)
  227. C write(*,*) fg(2), fd(2)
  228. C if (idim .eq. 3) write(*,*) fg(3), fd(3)
  229. C
  230. DO ICOMP = 1, IDIM, 1
  231. RESD(5 + IDIM + NPAR + ICOMP) = (FD(ICOMP) * SURF / VOLD)
  232. RESG(5 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(ICOMP) * SURF /
  233. $ VOLG)
  234. ENDDO
  235. C
  236. C rho2 alpha2 et2
  237. C
  238. FG(1) = FLU(2 + IDIM) * SCON2 + FLULAG(2 + IDIM) * SG2
  239. FD(1) = FLU(2 + IDIM) * SCON2 - FLULAG(2 + IDIM) * SD2
  240. RESD(6 + (2 * IDIM) + NPAR) = (FD(1) * SURF / VOLD)
  241. RESG(6 + (2 * IDIM) + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
  242. C
  243. DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1
  244. FG(1) = FLU(ICOMP) * SCON2 + FLULAG(ICOMP) * SG2
  245. FD(1) = FLU(ICOMP) * SCON2 - FLULAG(ICOMP) * SD2
  246. RESD(3 + IDIM + NPAR + ICOMP) = (FD(1) * SURF / VOLD)
  247. RESG(3 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(1) * SURF /
  248. $ VOLG)
  249. ENDDO
  250. C
  251. C write(*,*) 'S'
  252. C write(*,*) SCON1, SG1, SD1,
  253. C & SCON2, SG2, SD2
  254. C DO ICOMP = 1, (3 + IDIM + NPAR), 1
  255. C write(*,*) 'icomp, resd, resg'
  256. C write(*,*) icomp, resd(icomp),resg(icomp)
  257. C ENDDO
  258. C
  259. C write(*,*) 'Conservativity check'
  260. C do icomp = 1, 3 + IDIM + NPAR
  261. C write(*,*) ((resg(icomp) + resg(3 + IDIM + NPAR + icomp))
  262. C & * volg) +
  263. C & ((resd(icomp) + resd(3 + IDIM + NPAR + icomp))
  264. C & * vold)
  265. C enddo
  266. RETURN
  267. END
  268. *
  269.  
  270.  

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