Télécharger pride1.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIDE1 SOURCE BECC 10/06/23 21:15:01 6691
  2. SUBROUTINE PRIDE1(NESP,NORD,TMAX,RUNIV,PROPHY,
  3. & MLRCHE,MLRMFR,
  4. & ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2,
  5. & ITG1,ITG2,
  6. & IRN1,IRN2,
  7. & IVN1,IVN2,IPN1,IPN2,ITN1,ITN2,
  8. & EPS,
  9. & LOGAN,LOGIPG,LOGNEG,LOGBOR,LOGNC,
  10. & VALER,VAL1,VAL2)
  11. C
  12. C************************************************************************
  13. C
  14. C PROJET : CASTEM 2000
  15. C
  16. C NOM : PRIDE1
  17. C
  18. C DESCRIPTION : VOIR PRIDEM
  19. C
  20. C Melange des gaz "reactive thermally perfect".
  21. C
  22. C Calcul de la vitesse, de la pression, de la
  23. C temperature
  24. C
  25. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  26. C
  27. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/TTMF
  28. C
  29. C************************************************************************
  30. C
  31. C APPELES de calcul : CONTHE
  32. C
  33. C************************************************************************
  34. C
  35. C ENTREES : NESP : nombre d'especes dans le melange.
  36. C
  37. C NORD : ordre des polynoms du cv_i
  38. C
  39. C TMAX : maximum temperature for cv expansion
  40. C
  41. C RUNIV : universal constant for gases
  42. C
  43. C PROPHY : thermodynamic properties for the gases
  44. C
  45. C MLRCHE : LISTREEL with the coefS involved in the chemical
  46. C reaction
  47. C
  48. C MLRMFR : LISTREEL with the mass fractions before or after
  49. C the chemical reaction
  50. C
  51. C ICEN : MELEME of the mesh
  52. C
  53. C IALP1, IALP2, IARN1, IARN2, IAGN1, IAGN2, IARET1, IARET2,
  54. C ITG1, ITG2 : pointeurs of the input CHAMPOINs
  55. C
  56. C IRN1, IRN2, IVN1, IVN2, IPN1, IPN2, ITN1, ITN2:
  57. C pointeurs of the input CHAMPOINs
  58. C
  59. C SORTIES :
  60. C
  61. C LOGAN : anomalie detectée
  62. C
  63. C LOGNEG : (LOGICAL): si .TRUE. une densité ou un temperature
  64. C negative a été detectée -> le programme s'arrete
  65. C et on peut visualiser le champe de densite ou de
  66. C temperature (sa valeur stockée en MESERR(1) et
  67. C VALER(1))
  68. C
  69. C LOGBOR : (LOGICAL)
  70. C si .TRUE. la fraction massique a ete
  71. C detecté dehor YMIN et YMAX
  72. C (sa valeur stockée en MESERR(2) et VALER(2)
  73. C ,VAL1,VAL2)
  74. C
  75. C LOGIPG : si .TRUE., cv(T) < 0
  76. C
  77. C LOGNC : si .TRUE., Newton Rapson pour le calcul de T
  78. C n'a pas converge
  79. C
  80. C MESERR(2),
  81. C VALER(2),
  82. C VAL1,
  83. C VAL2 : pour message d'erreur
  84. C
  85. C
  86. C************************************************************************
  87. C
  88. C HISTORIQUE (Anomalies et modifications éventuelles)
  89. C
  90. C HISTORIQUE : Crée le 06.11.09.
  91. C
  92. C************************************************************************
  93. C
  94. C
  95. C**** Variables de COOPTIO
  96. C
  97. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  98. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  99. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  100. C & ,IECHO, IIMPI, IOSPI
  101. C & ,IDIM
  102. C & ,MCOORD
  103. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  104. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  105. C & ,NORINC,NORVAL,NORIND,NORVAD
  106. C & ,NUCROU, IPSAUV
  107. C
  108. C**** Les variables
  109. C
  110. IMPLICIT INTEGER(I-N)
  111. INTEGER NESP,NORD
  112. & ,ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2
  113. & ,ITG1,ITG2
  114. & ,IRN1, IRN2, IVN1, IVN2, IPN1, IPN2, ITN1, ITN2
  115. & ,N1,NLCE,IESP,IGEOMC
  116. C
  117. C**** NESP = Nombre d'especes dans le gaz.
  118. C
  119. REAL*8 RUNIV, TMAX, EPSI, VALER(2), VAL1, VAL2
  120. & , YMIN, YMAX
  121. & , EPS
  122. & , UX, UY, UZ, RO, ALPHA, T, P
  123. & , YNESPI, YNESPF
  124. & , ACOE1, YINI, YFIN, DYCO, UVEC(5), TGUESS
  125. CHARACTER*(8) TYPE
  126. CHARACTER*(40) MESERR(2)
  127. LOGICAL LOGNEG, LOGBOR, LOGAN, LOGNC, LOGIPG
  128. C
  129. C**** Valeur minimum di Y
  130. C
  131. C N.B.: il doit etre le meme dans gamma.eso.
  132. C
  133. PARAMETER(EPSI=1.0D-4,
  134. & YMIN=-EPSI,YMAX=1.0D0+EPSI)
  135. C
  136. C**** Les includes
  137. C
  138.  
  139. -INC PPARAM
  140. -INC CCOPTIO
  141. -INC SMCHPOI
  142. POINTEUR MPALP1.MPOVAL, MPALP2.MPOVAL,
  143. & MPARO1.MPOVAL, MPARO2.MPOVAL,
  144. & MPAGN1.MPOVAL, MPAGN2.MPOVAL,
  145. & MPARE1.MPOVAL, MPARE2.MPOVAL,
  146. & MPOTG1.MPOVAL, MPOTG2.MPOVAL,
  147. & MPOVN1.MPOVAL, MPOVN2.MPOVAL,
  148. & MPOPN1.MPOVAL, MPOPN2.MPOVAL,
  149. & MPORN1.MPOVAL, MPORN2.MPOVAL,
  150. & MPOTN1.MPOVAL, MPOTN2.MPOVAL
  151. -INC SMLREEL
  152. POINTEUR MLRCHE.MLREEL, MLRMFR.MLREEL,
  153. & MLRYIN.MLREEL, MLRYFI.MLREEL
  154. -INC SMELEME
  155. C
  156. C**** Segment du propriete du gaz
  157. C
  158. SEGMENT PROPHY
  159. REAL*8 ACV(NORD+1,NESP), W(NESP), H0K(NESP)
  160. ENDSEGMENT
  161. SEGACT PROPHY
  162. C
  163. C**** Initialisation des variables pour la gestion des erreurs pas ici,
  164. C mais avant
  165. C
  166. SEGMENT SUMCV
  167. REAL*8 ACVTOT(NORD+1)
  168. ENDSEGMENT
  169. SEGINI SUMCV
  170. C
  171. C**** Activation du MELEME "CENTRE"
  172. C
  173. IPT1 = ICEN
  174. SEGACT IPT1
  175. N1 = IPT1.NUM(/2)
  176. SEGDES IPT1
  177. C
  178. C**** Lecture des MPOVALs
  179. C
  180. CALL LICHT(IALP1, MPALP1,TYPE,IGEOMC)
  181. CALL LICHT(IARN1, MPARO1,TYPE,IGEOMC)
  182. CALL LICHT(IAGN1, MPAGN1,TYPE,IGEOMC)
  183. CALL LICHT(IARET1,MPARE1,TYPE,IGEOMC)
  184. CALL LICHT(ITG1, MPOTG1,TYPE,IGEOMC)
  185. CALL LICHT(IVN1, MPOVN1,TYPE,IGEOMC)
  186. CALL LICHT(IPN1, MPOPN1,TYPE,IGEOMC)
  187. CALL LICHT(IRN1, MPORN1,TYPE,IGEOMC)
  188. CALL LICHT(ITN1, MPOTN1,TYPE,IGEOMC)
  189. C
  190. CALL LICHT(IALP2,MPALP2,TYPE,IGEOMC)
  191. CALL LICHT(IARN2,MPARO2,TYPE,IGEOMC)
  192. CALL LICHT(IAGN2,MPAGN2,TYPE,IGEOMC)
  193. CALL LICHT(IARET2,MPARE2,TYPE,IGEOMC)
  194. CALL LICHT(ITG2,MPOTG2,TYPE,IGEOMC)
  195. CALL LICHT(IVN2,MPOVN2,TYPE,IGEOMC)
  196. CALL LICHT(IPN2,MPOPN2,TYPE,IGEOMC)
  197. CALL LICHT(IRN2,MPORN2,TYPE,IGEOMC)
  198. CALL LICHT(ITN2,MPOTN2,TYPE,IGEOMC)
  199. C
  200. C**** LICHT active les MPOVALs en *MOD
  201. C
  202. C i.e.
  203. C
  204. C SEGACT
  205. C
  206. C
  207. C**** Computation of the mass fractions
  208. C
  209. SEGACT MLRMFR
  210. SEGACT MLRCHE
  211. SEGINI, MLRYIN = MLRMFR
  212. SEGINI, MLRYFI = MLRMFR
  213. YNESPI = 1.0D0
  214. YNESPF = 1.0D0
  215. ACOE1 = MLRCHE.PROG(1)
  216. IF (ACOE1 .LE. 0.0D0)THEN
  217. WRITE(IOIMP,*) 'TAB1 . CHEMCOEF = ??? '
  218. WRITE(IOIMP,*) 'First coefficient <= 0 '
  219. CALL ERREUR(21)
  220. GOTO 9999
  221. ENDIF
  222. YINI = MLRMFR.PROG(1)
  223. YFIN = MLRMFR.PROG(2)
  224. YNESPF = YNESPF - YFIN
  225. YNESPI = YNESPI - YINI
  226. MLRYIN.PROG(1) = YINI
  227. MLRYFI.PROG(1) = YFIN
  228. DYCO = (YINI - YFIN) / (ACOE1 * PROPHY.W(1))
  229. IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
  230. MESERR(2) = 'YINI '
  231. VALER(2) = YINI
  232. LOGBOR = .TRUE.
  233. VAL1 = YMIN
  234. VAL2 = YMAX
  235. ENDIF
  236. IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
  237. MESERR(2) = 'YFIN '
  238. VALER(2) = YFIN
  239. LOGBOR = .TRUE.
  240. VAL1 = YMIN
  241. VAL2 = YMAX
  242. ENDIF
  243. DO IESP = 2 , (NESP - 1), 1
  244. ACOE1 = MLRCHE.PROG(IESP)
  245. IF (ACOE1 .GT. 0.0D0) THEN
  246. YFIN = MLRMFR.PROG(IESP + 1)
  247. YINI = YFIN + (DYCO * (ACOE1 * PROPHY.W(IESP)))
  248. ELSE
  249. YINI = MLRMFR.PROG(IESP + 1)
  250. YFIN = YINI - (DYCO * (ACOE1 * PROPHY.W(IESP)))
  251. ENDIF
  252. MLRYFI.PROG(IESP) = YFIN
  253. MLRYIN.PROG(IESP) = YINI
  254. YNESPF = YNESPF - YFIN
  255. YNESPI = YNESPI - YINI
  256. IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
  257. MESERR(2) = 'YINI '
  258. VALER(2) = YINI
  259. LOGBOR = .TRUE.
  260. VAL1 = YMIN
  261. VAL2 = YMAX
  262. ENDIF
  263. IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
  264. MESERR(2) = 'YFIN '
  265. VALER(2) = YFIN
  266. LOGBOR = .TRUE.
  267. VAL1 = YMIN
  268. VAL2 = YMAX
  269. ENDIF
  270. ENDDO
  271. IF((YNESPI .LT. YMIN) .OR. (YNESPI .GT. YMAX))THEN
  272. MESERR(2) = 'YNESPI '
  273. VALER(2) = YNESPI
  274. LOGBOR = .TRUE.
  275. VAL1 = YMIN
  276. VAL2 = YMAX
  277. ENDIF
  278. IF((YNESPF .LT. YMIN) .OR. (YNESPF .GT. YMAX))THEN
  279. MESERR(2) = 'YFIN '
  280. VALER(2) = YFIN
  281. LOGBOR = .TRUE.
  282. VAL1 = YMIN
  283. VAL2 = YMAX
  284. ENDIF
  285. MLRYFI.PROG(NESP) = YNESPF
  286. MLRYIN.PROG(NESP) = YNESPI
  287. C
  288. c write(*,*) 'Initial mass fractions'
  289. c do iesp = 1 , nesp
  290. c write(*,*) iesp, mlryin.prog(iesp)
  291. c enddo
  292. c write(*,*) 'Final mass fractions'
  293. c do iesp = 1 , nesp
  294. c write(*,*) mlryfi.prog(iesp)
  295. c enddo
  296. c
  297. C
  298. C**** BOUCLE SUR LES CENTRES pour le calcul des MPOVAL
  299. C
  300. DO NLCE = 1, N1
  301. C
  302. C******* Les differents variables a chaque centre
  303. C
  304. ALPHA = MPALP1.VPOCHA(NLCE,1)
  305. IF (ALPHA .GT. EPS) THEN
  306. RO = MPARO1.VPOCHA(NLCE,1) / ALPHA
  307. UVEC(1) = RO
  308. IF(RO .LE. 0.0D0)THEN
  309. VALER(1) = RO
  310. MESERR(1) = 'RO '
  311. LOGNEG = .TRUE.
  312. GOTO 9999
  313. ENDIF
  314. UVEC(2) = MPAGN1.VPOCHA(NLCE,1) / ALPHA
  315. UVEC(3) = MPAGN1.VPOCHA(NLCE,2) / ALPHA
  316. IF (IDIM .EQ. 3) THEN
  317. UVEC(4) = MPAGN1.VPOCHA(NLCE,3) / ALPHA
  318. ELSE
  319. UVEC(4) = 0.0D0
  320. ENDIF
  321. UVEC(5) = MPARE1.VPOCHA(NLCE,1) / ALPHA
  322. TGUESS = MPOTG1.VPOCHA(NLCE,1)
  323. CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
  324. & RUNIV, TMAX, UVEC, MLRYIN.PROG,
  325. & TGUESS,
  326. & SUMCV.ACVTOT,
  327. & UX, UY, UZ, P, T,
  328. & LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
  329. IF (LOGNC .OR. LOGNEG)THEN
  330. GOTO 9999
  331. ENDIF
  332. MPOVN1.VPOCHA(NLCE,1) = UX
  333. MPOVN1.VPOCHA(NLCE,2) = UY
  334. IF (IDIM .EQ. 3) THEN
  335. MPOVN1.VPOCHA(NLCE,3) = UZ
  336. ENDIF
  337. MPOTN1.VPOCHA(NLCE,1) = T
  338. MPOPN1.VPOCHA(NLCE,1) = P
  339. MPORN1.VPOCHA(NLCE,1) = RO
  340. ENDIF
  341. C
  342. ALPHA = MPALP2.VPOCHA(NLCE,1)
  343. IF (ALPHA .GT. EPS) THEN
  344. RO = MPARO2.VPOCHA(NLCE,1) / ALPHA
  345. UVEC(1) = RO
  346. IF(RO .LE. 0.0D0)THEN
  347. VALER(1) = RO
  348. MESERR(1) = 'RO '
  349. LOGNEG = .TRUE.
  350. GOTO 9999
  351. ENDIF
  352. UVEC(2) = MPAGN2.VPOCHA(NLCE,1) / ALPHA
  353. UVEC(3) = MPAGN2.VPOCHA(NLCE,2) / ALPHA
  354. IF (IDIM .EQ. 3) THEN
  355. UVEC(4) = MPAGN2.VPOCHA(NLCE,3) / ALPHA
  356. ELSE
  357. UVEC(4) = 0.0D0
  358. ENDIF
  359. UVEC(5) = MPARE2.VPOCHA(NLCE,1) / ALPHA
  360. TGUESS = MPOTG2.VPOCHA(NLCE,1)
  361. CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
  362. & RUNIV, TMAX, UVEC, MLRYFI.PROG,
  363. & TGUESS,
  364. & SUMCV.ACVTOT,
  365. & UX, UY, UZ, P, T,
  366. & LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
  367. IF (LOGNC .OR. LOGNEG)THEN
  368. GOTO 9999
  369. ENDIF
  370. MPOVN2.VPOCHA(NLCE,1) = UX
  371. MPOVN2.VPOCHA(NLCE,2) = UY
  372. IF (IDIM .EQ. 3) THEN
  373. MPOVN2.VPOCHA(NLCE,3) = UZ
  374. ENDIF
  375. MPOTN2.VPOCHA(NLCE,1) = T
  376. MPOPN2.VPOCHA(NLCE,1) = P
  377. MPORN2.VPOCHA(NLCE,1) = RO
  378. ENDIF
  379. C
  380. C**** Fin boucle sur les points
  381. C
  382. ENDDO
  383. C
  384. 9999 CONTINUE
  385. C
  386. SEGDES MPALP1
  387. SEGDES MPARO1
  388. SEGDES MPAGN1
  389. SEGDES MPARE1
  390. SEGDES MPOTG1
  391. SEGDES MPOVN1
  392. SEGDES MPOPN1
  393. SEGDES MPORN1
  394. SEGDES MPOTN1
  395. SEGDES MPALP2
  396. SEGDES MPARO2
  397. SEGDES MPAGN2
  398. SEGDES MPARE2
  399. SEGDES MPOTG2
  400. SEGDES MPOVN2
  401. SEGDES MPOPN2
  402. SEGDES MPORN2
  403. SEGDES MPOTN2
  404. C
  405. SEGDES PROPHY
  406. C
  407. SEGDES MLRMFR
  408. SEGDES MLRCHE
  409. C
  410. SEGSUP MLRYIN
  411. SEGSUP MLRYFI
  412. SEGSUP SUMCV
  413. C
  414. RETURN
  415. END
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  

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