Télécharger prgfm1.eso

Retour à la liste

Numérotation des lignes :

  1. C PRGFM1 SOURCE BECC 11/05/18 21:15:34 6973
  2. SUBROUTINE PRGFM1(NESP,
  3. & IM1,IPHI,ICH1,ICH2,ICH3,ICH4,ICH5,
  4. & MLRMGA,MLRPGA,MLRMPI,MLRPPI,
  5. & IVIT,IPRES,IY,
  6. & LOGNEG,MESERR,
  7. & VALER)
  8. C************************************************************************
  9. C
  10. C PROJET : CASTEM 2000
  11. C
  12. C NOM : PRGFM1
  13. C
  14. C DESCRIPTION : VOIR PRIGFM
  15. C
  16. C Gaz ideal mono-espece:
  17. C Calcul de vitesse, pression.
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  20. C
  21. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  22. C
  23. C************************************************************************
  24. C
  25. C APPELES (E/S) : LICHT
  26. C
  27. C************************************************************************
  28. C
  29. C ENTREES :
  30. C
  31. C NESP : nombre d'especes dans les equation d'Euler.
  32. C
  33. C IM1 : MELEME contenant les centres des ELTs
  34. C
  35. C IPHI : CHPOINT contenant PHI
  36. C
  37. C ICH1 : CHPOINT contenant la masse volumique.
  38. C
  39. C ICH2 : CHPOINT contenant les dèbits
  40. C ( NDIM composantes);
  41. C
  42. C ICH3 : CHPOINT contenat l'énergie totale per
  43. C unité de volume (RHO Et);
  44. C
  45. C ICH4, ICH5 : CHPOINT contenants rhoy et alpha ;
  46. C
  47. C MLRMGA,MLRPGA,MLRMPI,MLRPPI: proprietés des gaz 1
  48. C
  49. C SORTIES :
  50. C
  51. C IY : CHPOINT contenany y
  52. C
  53. C IVIT : CHPOINT contenant la vitesse
  54. C
  55. C IPRES : CHPOINT contenant la pression du gaz;
  56. C
  57. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  58. C negative a été detectée -> le programme s'arrete
  59. C (sa valeur stockée en MESERR(1) et VALER(1))
  60. C
  61. C MESERR,
  62. C VALER : pour message d'erreur
  63. C
  64. C
  65. C************************************************************************
  66. C
  67. C HISTORIQUE (Anomalies et modifications éventuelles)
  68. C
  69. C HISTORIQUE : Créée le 1.11.2010
  70. C
  71. C************************************************************************
  72. C
  73. C
  74. C**** Variables de COOPTIO
  75. C
  76. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  77. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  78. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  79. C & ,IECHO, IIMPI, IOSPI
  80. C & ,IDIM
  81. C & ,MCOORD
  82. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  83. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  84. C & ,NORINC,NORVAL,NORIND,NORVAD
  85. C & ,NUCROU, IPSAUV
  86. C
  87. C**** Les variables
  88. C
  89. IMPLICIT INTEGER(I-N)
  90. INTEGER NESP, IESP,
  91. & IM1,ICH1,ICH2,ICH3,ICH4,ICH5
  92. & ,IVIT,IPRES,IPHI, IY
  93. & ,NLCE, N1, IGEOMC
  94. REAL*8 VALER(2)
  95. & ,RO,UX,UY,UZ,P
  96. & ,ROET, ROETH, CELL, PHI
  97. & ,GAMMA,PINF
  98. & ,ALP, RNUM, DEN, ALPI
  99. C
  100. CHARACTER*(8) TYPE
  101. CHARACTER*(40) MESERR(2)
  102. LOGICAL LOGNEG
  103. C
  104. C
  105. C**** Les includes
  106. C
  107. -INC CCOPTIO
  108. -INC SMCHPOI
  109. POINTEUR MPOVA7.MPOVAL, MPOVRY.MPOVAL,
  110. & MPOVAY.MPOVAL, MPOALP.MPOVAL
  111. -INC SMELEME
  112. -INC SMLREEL
  113. POINTEUR MLRMGA.MLREEL, MLRPGA.MLREEL,
  114. & MLRMPI.MLREEL, MLRPPI.MLREEL
  115. C
  116. C
  117. C**** Initialisation des variables pour la gestion des erreurs pas ici,
  118. C mais avant, i.e.
  119. C
  120. C LOGNEG = .FALSE.
  121. C MESERR(1) = ' '
  122. C MESERR(2) = ' '
  123. C
  124. C**** Activation du MELEME "CENTRE"
  125. C
  126. IPT1 = IM1
  127. SEGACT IPT1
  128. N1 = IPT1.NUM(/2)
  129. SEGDES IPT1
  130. C
  131. C**** Creation des CHPOINTs IVIT, IPRES
  132. C
  133. C ITEMP CHPOINT simile aux ICH1
  134. C Donc on lit ICH1
  135. C
  136. MCHPO1 = ICH1
  137. SEGACT MCHPO1
  138. MSOUP1 = MCHPO1.IPCHP(1)
  139. SEGDES MCHPO1
  140. SEGACT MSOUP1
  141. MPOVA1 = MSOUP1.IPOVAL
  142. SEGDES MSOUP1
  143. SEGACT MPOVA1
  144. C
  145. C*** MPOVA6 = IPOVAL de IPRES
  146. C
  147. SEGINI, MPOVA6 = MPOVA1
  148. SEGINI, MSOUP2 = MSOUP1
  149. MSOUP2.IPOVAL = MPOVA6
  150. SEGINI, MCHPO2 = MCHPO1
  151. MCHPO2.IPCHP(1)= MSOUP2
  152. SEGDES MSOUP2
  153. SEGDES MCHPO2
  154. IPRES = MCHPO2
  155. C
  156. C*** IVIT simil au CHPOINT ICH2 (DEBITs).
  157. C
  158. MCHPO1 = ICH2
  159. SEGACT MCHPO1
  160. MSOUP1 = MCHPO1.IPCHP(1)
  161. SEGDES MCHPO1
  162. SEGACT MSOUP1
  163. MPOVA2 = MSOUP1.IPOVAL
  164. SEGDES MSOUP1
  165. SEGACT MPOVA2
  166. C
  167. C**** IVIT
  168. C
  169. SEGINI, MPOVA5 = MPOVA2
  170. SEGINI, MSOUP2 = MSOUP1
  171. MSOUP2.IPOVAL = MPOVA5
  172. SEGINI, MCHPO2 = MCHPO1
  173. MCHPO2.IPCHP(1)= MSOUP2
  174. SEGDES MSOUP2
  175. SEGDES MCHPO2
  176. IVIT = MCHPO2
  177. C
  178. IF (NESP .GE. 1) THEN
  179. C
  180. C*** IY
  181. C
  182. C Ce CHPOINT ressemble à IROY
  183. C Donc on lit IROY
  184. C
  185. MCHPO1 = ICH4
  186. SEGACT MCHPO1
  187. MSOUP1 = MCHPO1.IPCHP(1)
  188. SEGDES MCHPO1
  189. SEGACT MSOUP1
  190. MPOVRY = MSOUP1.IPOVAL
  191. SEGDES MSOUP1
  192. SEGACT MPOVRY
  193. C
  194. SEGINI, MPOVAY = MPOVRY
  195. SEGINI, MSOUP2 = MSOUP1
  196. MSOUP2.IPOVAL = MPOVAY
  197. SEGINI, MCHPO2 = MCHPO1
  198. MCHPO2.IPCHP(1)= MSOUP2
  199. SEGDES MSOUP2
  200. SEGDES MCHPO2
  201. IY = MCHPO2
  202. C
  203. CALL LICHT(ICH5,MPOALP,TYPE,IGEOMC)
  204. C SEGACT MPOALP
  205. ELSE
  206. IY=0
  207. ENDIF
  208. C
  209. C**** Lecture de MPOVALs des autres MCHPOIs
  210. C
  211. CALL LICHT(ICH3,MPOVA3,TYPE,IGEOMC)
  212. CALL LICHT(IPHI,MPOVA7,TYPE,IGEOMC)
  213. C
  214. C**** LICHT active les MPOVALs en *MOD
  215. C
  216. C i.e.
  217. C
  218. C SEGACT MPOVA3*MOD
  219. C SEGACT MPOVA7*MOD
  220. C
  221. C
  222. C**** RICAPITOLATIF
  223. C
  224. C On a activé que les MPOVA1 - MPOVA7
  225. C
  226. C MPOVA1 = RO
  227. C MPOVA2 = DEBIT
  228. C MPOVA3 = ROET
  229. C MPOVA5 = VITESSE
  230. C MPOVA6 = PRES
  231. C MPOVA7 = IPHI
  232. C MPOVRY = RHO Y
  233. C MPOVAY = Y
  234. C MPOALP = ALPHA
  235. C
  236. C**** BOUCLE SUR LES CENTRES pour le calcul du FLUX.
  237. C
  238. DO NLCE = 1, N1
  239. C
  240. C******* Les differents variables a chaque centre
  241. C
  242. RO = MPOVA1.VPOCHA(NLCE,1)
  243. IF(RO .LE. 0.0D0)THEN
  244. VALER(1) = RO
  245. MESERR(1) = 'RO '
  246. LOGNEG = .TRUE.
  247. C
  248. C********** RO < 0: le programme s'arrete mais apres le calcul des
  249. C CHPOINTs
  250. C
  251. ENDIF
  252. UX = MPOVA2.VPOCHA(NLCE,1)/RO
  253. UY = MPOVA2.VPOCHA(NLCE,2)/RO
  254. MPOVA5.VPOCHA(NLCE,1)=UX
  255. MPOVA5.VPOCHA(NLCE,2)=UY
  256. IF(IDIM .EQ. 3) THEN
  257. UZ = MPOVA2.VPOCHA(NLCE,3)/RO
  258. MPOVA5.VPOCHA(NLCE,3)=UZ
  259. ENDIF
  260. ROET = MPOVA3.VPOCHA(NLCE,1)
  261. PHI = MPOVA7.VPOCHA(NLCE,1)
  262. CELL = UX*UX + UY*UY
  263. IF(IDIM .EQ. 3) CELL = CELL +UZ*UZ
  264. CELL = 0.5D0 * CELL *RO
  265. ROETH = ROET - CELL
  266. C
  267. C******* We compute GAMMA and PINF
  268. C
  269. ALP = 1.0D0
  270. DEN = 0.0D0
  271. RNUM = 0.0D0
  272. DO IESP = 1, NESP, 1
  273. IF (PHI .LE. 0)THEN
  274. GAMMA = MLRMGA.PROG(IESP)
  275. PINF = MLRMPI.PROG(IESP)
  276. ELSE
  277. GAMMA = MLRPGA.PROG(IESP)
  278. PINF = MLRPPI.PROG(IESP)
  279. ENDIF
  280. ALPI = MPOALP.VPOCHA(NLCE,IESP)
  281. ALP = ALP - ALPI
  282. DEN = DEN + (ALPI / (GAMMA - 1.0D0))
  283. RNUM = RNUM + ((ALPI * GAMMA * PINF) / (GAMMA - 1.0D0))
  284. ENDDO
  285. IF (PHI .LE. 0)THEN
  286. GAMMA = MLRMGA.PROG(NESP + 1)
  287. PINF = MLRMPI.PROG(NESP + 1)
  288. ELSE
  289. GAMMA = MLRPGA.PROG(NESP + 1)
  290. PINF = MLRPPI.PROG(NESP + 1)
  291. ENDIF
  292. DEN = DEN + (ALP / (GAMMA - 1.0D0))
  293. RNUM = RNUM + ((ALP * GAMMA * PINF) / (GAMMA - 1.0D0))
  294. C
  295. PINF = RNUM / DEN
  296. GAMMA = 1.0D0 / DEN
  297. GAMMA = GAMMA + 1.0D0
  298. PINF = PINF / GAMMA
  299. C
  300. C write(*,*)
  301. C write(*,*) 'gamma, pinf ', gamma, pinf
  302. P = (GAMMA - 1.0D0) * ROETH
  303. P = P - (GAMMA * PINF)
  304. IF(P .LE. (-1.0D0 * PINF)) THEN
  305. VALER(1) = P
  306. MESERR(1) = 'P '
  307. LOGNEG = .TRUE.
  308. C
  309. C********** P < 0: le programme s'arrete mais apres le calcul des
  310. C CHPOINTs
  311. C
  312. ENDIF
  313. MPOVA6.VPOCHA(NLCE,1) = P
  314. C
  315. DO IESP = 1, NESP
  316. MPOVAY.VPOCHA(NLCE,IESP) = MPOVRY.VPOCHA(NLCE,IESP) / RO
  317. ENDDO
  318. ENDDO
  319. C
  320. SEGDES MPOVA1
  321. SEGDES MPOVA2
  322. SEGDES MPOVA3
  323. SEGDES MPOVA5
  324. SEGDES MPOVA6
  325. SEGDES MPOVA7
  326. IF (NESP .GE. 1) THEN
  327. SEGDES MPOVRY
  328. SEGDES MPOALP
  329. SEGDES MPOVAY
  330. ENDIF
  331. C
  332. RETURN
  333. END
  334.  
  335.  

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