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. -INC CCOPTIO
  139. -INC SMCHPOI
  140. POINTEUR MPALP1.MPOVAL, MPALP2.MPOVAL,
  141. & MPARO1.MPOVAL, MPARO2.MPOVAL,
  142. & MPAGN1.MPOVAL, MPAGN2.MPOVAL,
  143. & MPARE1.MPOVAL, MPARE2.MPOVAL,
  144. & MPOTG1.MPOVAL, MPOTG2.MPOVAL,
  145. & MPOVN1.MPOVAL, MPOVN2.MPOVAL,
  146. & MPOPN1.MPOVAL, MPOPN2.MPOVAL,
  147. & MPORN1.MPOVAL, MPORN2.MPOVAL,
  148. & MPOTN1.MPOVAL, MPOTN2.MPOVAL
  149. -INC SMLREEL
  150. POINTEUR MLRCHE.MLREEL, MLRMFR.MLREEL,
  151. & MLRYIN.MLREEL, MLRYFI.MLREEL
  152. -INC SMELEME
  153. C
  154. C**** Segment du propriete du gaz
  155. C
  156. SEGMENT PROPHY
  157. REAL*8 ACV(NORD+1,NESP), W(NESP), H0K(NESP)
  158. ENDSEGMENT
  159. SEGACT PROPHY
  160. C
  161. C**** Initialisation des variables pour la gestion des erreurs pas ici,
  162. C mais avant
  163. C
  164. SEGMENT SUMCV
  165. REAL*8 ACVTOT(NORD+1)
  166. ENDSEGMENT
  167. SEGINI SUMCV
  168. C
  169. C**** Activation du MELEME "CENTRE"
  170. C
  171. IPT1 = ICEN
  172. SEGACT IPT1
  173. N1 = IPT1.NUM(/2)
  174. SEGDES IPT1
  175. C
  176. C**** Lecture des MPOVALs
  177. C
  178. CALL LICHT(IALP1, MPALP1,TYPE,IGEOMC)
  179. CALL LICHT(IARN1, MPARO1,TYPE,IGEOMC)
  180. CALL LICHT(IAGN1, MPAGN1,TYPE,IGEOMC)
  181. CALL LICHT(IARET1,MPARE1,TYPE,IGEOMC)
  182. CALL LICHT(ITG1, MPOTG1,TYPE,IGEOMC)
  183. CALL LICHT(IVN1, MPOVN1,TYPE,IGEOMC)
  184. CALL LICHT(IPN1, MPOPN1,TYPE,IGEOMC)
  185. CALL LICHT(IRN1, MPORN1,TYPE,IGEOMC)
  186. CALL LICHT(ITN1, MPOTN1,TYPE,IGEOMC)
  187. C
  188. CALL LICHT(IALP2,MPALP2,TYPE,IGEOMC)
  189. CALL LICHT(IARN2,MPARO2,TYPE,IGEOMC)
  190. CALL LICHT(IAGN2,MPAGN2,TYPE,IGEOMC)
  191. CALL LICHT(IARET2,MPARE2,TYPE,IGEOMC)
  192. CALL LICHT(ITG2,MPOTG2,TYPE,IGEOMC)
  193. CALL LICHT(IVN2,MPOVN2,TYPE,IGEOMC)
  194. CALL LICHT(IPN2,MPOPN2,TYPE,IGEOMC)
  195. CALL LICHT(IRN2,MPORN2,TYPE,IGEOMC)
  196. CALL LICHT(ITN2,MPOTN2,TYPE,IGEOMC)
  197. C
  198. C**** LICHT active les MPOVALs en *MOD
  199. C
  200. C i.e.
  201. C
  202. C SEGACT
  203. C
  204. C
  205. C**** Computation of the mass fractions
  206. C
  207. SEGACT MLRMFR
  208. SEGACT MLRCHE
  209. SEGINI, MLRYIN = MLRMFR
  210. SEGINI, MLRYFI = MLRMFR
  211. YNESPI = 1.0D0
  212. YNESPF = 1.0D0
  213. ACOE1 = MLRCHE.PROG(1)
  214. IF (ACOE1 .LE. 0.0D0)THEN
  215. WRITE(IOIMP,*) 'TAB1 . CHEMCOEF = ??? '
  216. WRITE(IOIMP,*) 'First coefficient <= 0 '
  217. CALL ERREUR(21)
  218. GOTO 9999
  219. ENDIF
  220. YINI = MLRMFR.PROG(1)
  221. YFIN = MLRMFR.PROG(2)
  222. YNESPF = YNESPF - YFIN
  223. YNESPI = YNESPI - YINI
  224. MLRYIN.PROG(1) = YINI
  225. MLRYFI.PROG(1) = YFIN
  226. DYCO = (YINI - YFIN) / (ACOE1 * PROPHY.W(1))
  227. IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
  228. MESERR(2) = 'YINI '
  229. VALER(2) = YINI
  230. LOGBOR = .TRUE.
  231. VAL1 = YMIN
  232. VAL2 = YMAX
  233. ENDIF
  234. IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
  235. MESERR(2) = 'YFIN '
  236. VALER(2) = YFIN
  237. LOGBOR = .TRUE.
  238. VAL1 = YMIN
  239. VAL2 = YMAX
  240. ENDIF
  241. DO IESP = 2 , (NESP - 1), 1
  242. ACOE1 = MLRCHE.PROG(IESP)
  243. IF (ACOE1 .GT. 0.0D0) THEN
  244. YFIN = MLRMFR.PROG(IESP + 1)
  245. YINI = YFIN + (DYCO * (ACOE1 * PROPHY.W(IESP)))
  246. ELSE
  247. YINI = MLRMFR.PROG(IESP + 1)
  248. YFIN = YINI - (DYCO * (ACOE1 * PROPHY.W(IESP)))
  249. ENDIF
  250. MLRYFI.PROG(IESP) = YFIN
  251. MLRYIN.PROG(IESP) = YINI
  252. YNESPF = YNESPF - YFIN
  253. YNESPI = YNESPI - YINI
  254. IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
  255. MESERR(2) = 'YINI '
  256. VALER(2) = YINI
  257. LOGBOR = .TRUE.
  258. VAL1 = YMIN
  259. VAL2 = YMAX
  260. ENDIF
  261. IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
  262. MESERR(2) = 'YFIN '
  263. VALER(2) = YFIN
  264. LOGBOR = .TRUE.
  265. VAL1 = YMIN
  266. VAL2 = YMAX
  267. ENDIF
  268. ENDDO
  269. IF((YNESPI .LT. YMIN) .OR. (YNESPI .GT. YMAX))THEN
  270. MESERR(2) = 'YNESPI '
  271. VALER(2) = YNESPI
  272. LOGBOR = .TRUE.
  273. VAL1 = YMIN
  274. VAL2 = YMAX
  275. ENDIF
  276. IF((YNESPF .LT. YMIN) .OR. (YNESPF .GT. YMAX))THEN
  277. MESERR(2) = 'YFIN '
  278. VALER(2) = YFIN
  279. LOGBOR = .TRUE.
  280. VAL1 = YMIN
  281. VAL2 = YMAX
  282. ENDIF
  283. MLRYFI.PROG(NESP) = YNESPF
  284. MLRYIN.PROG(NESP) = YNESPI
  285. C
  286. c write(*,*) 'Initial mass fractions'
  287. c do iesp = 1 , nesp
  288. c write(*,*) iesp, mlryin.prog(iesp)
  289. c enddo
  290. c write(*,*) 'Final mass fractions'
  291. c do iesp = 1 , nesp
  292. c write(*,*) mlryfi.prog(iesp)
  293. c enddo
  294. c
  295. C
  296. C**** BOUCLE SUR LES CENTRES pour le calcul des MPOVAL
  297. C
  298. DO NLCE = 1, N1
  299. C
  300. C******* Les differents variables a chaque centre
  301. C
  302. ALPHA = MPALP1.VPOCHA(NLCE,1)
  303. IF (ALPHA .GT. EPS) THEN
  304. RO = MPARO1.VPOCHA(NLCE,1) / ALPHA
  305. UVEC(1) = RO
  306. IF(RO .LE. 0.0D0)THEN
  307. VALER(1) = RO
  308. MESERR(1) = 'RO '
  309. LOGNEG = .TRUE.
  310. GOTO 9999
  311. ENDIF
  312. UVEC(2) = MPAGN1.VPOCHA(NLCE,1) / ALPHA
  313. UVEC(3) = MPAGN1.VPOCHA(NLCE,2) / ALPHA
  314. IF (IDIM .EQ. 3) THEN
  315. UVEC(4) = MPAGN1.VPOCHA(NLCE,3) / ALPHA
  316. ELSE
  317. UVEC(4) = 0.0D0
  318. ENDIF
  319. UVEC(5) = MPARE1.VPOCHA(NLCE,1) / ALPHA
  320. TGUESS = MPOTG1.VPOCHA(NLCE,1)
  321. CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
  322. & RUNIV, TMAX, UVEC, MLRYIN.PROG,
  323. & TGUESS,
  324. & SUMCV.ACVTOT,
  325. & UX, UY, UZ, P, T,
  326. & LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
  327. IF (LOGNC .OR. LOGNEG)THEN
  328. GOTO 9999
  329. ENDIF
  330. MPOVN1.VPOCHA(NLCE,1) = UX
  331. MPOVN1.VPOCHA(NLCE,2) = UY
  332. IF (IDIM .EQ. 3) THEN
  333. MPOVN1.VPOCHA(NLCE,3) = UZ
  334. ENDIF
  335. MPOTN1.VPOCHA(NLCE,1) = T
  336. MPOPN1.VPOCHA(NLCE,1) = P
  337. MPORN1.VPOCHA(NLCE,1) = RO
  338. ENDIF
  339. C
  340. ALPHA = MPALP2.VPOCHA(NLCE,1)
  341. IF (ALPHA .GT. EPS) THEN
  342. RO = MPARO2.VPOCHA(NLCE,1) / ALPHA
  343. UVEC(1) = RO
  344. IF(RO .LE. 0.0D0)THEN
  345. VALER(1) = RO
  346. MESERR(1) = 'RO '
  347. LOGNEG = .TRUE.
  348. GOTO 9999
  349. ENDIF
  350. UVEC(2) = MPAGN2.VPOCHA(NLCE,1) / ALPHA
  351. UVEC(3) = MPAGN2.VPOCHA(NLCE,2) / ALPHA
  352. IF (IDIM .EQ. 3) THEN
  353. UVEC(4) = MPAGN2.VPOCHA(NLCE,3) / ALPHA
  354. ELSE
  355. UVEC(4) = 0.0D0
  356. ENDIF
  357. UVEC(5) = MPARE2.VPOCHA(NLCE,1) / ALPHA
  358. TGUESS = MPOTG2.VPOCHA(NLCE,1)
  359. CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
  360. & RUNIV, TMAX, UVEC, MLRYFI.PROG,
  361. & TGUESS,
  362. & SUMCV.ACVTOT,
  363. & UX, UY, UZ, P, T,
  364. & LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
  365. IF (LOGNC .OR. LOGNEG)THEN
  366. GOTO 9999
  367. ENDIF
  368. MPOVN2.VPOCHA(NLCE,1) = UX
  369. MPOVN2.VPOCHA(NLCE,2) = UY
  370. IF (IDIM .EQ. 3) THEN
  371. MPOVN2.VPOCHA(NLCE,3) = UZ
  372. ENDIF
  373. MPOTN2.VPOCHA(NLCE,1) = T
  374. MPOPN2.VPOCHA(NLCE,1) = P
  375. MPORN2.VPOCHA(NLCE,1) = RO
  376. ENDIF
  377. C
  378. C**** Fin boucle sur les points
  379. C
  380. ENDDO
  381. C
  382. 9999 CONTINUE
  383. C
  384. SEGDES MPALP1
  385. SEGDES MPARO1
  386. SEGDES MPAGN1
  387. SEGDES MPARE1
  388. SEGDES MPOTG1
  389. SEGDES MPOVN1
  390. SEGDES MPOPN1
  391. SEGDES MPORN1
  392. SEGDES MPOTN1
  393. SEGDES MPALP2
  394. SEGDES MPARO2
  395. SEGDES MPAGN2
  396. SEGDES MPARE2
  397. SEGDES MPOTG2
  398. SEGDES MPOVN2
  399. SEGDES MPOPN2
  400. SEGDES MPORN2
  401. SEGDES MPOTN2
  402. C
  403. SEGDES PROPHY
  404. C
  405. SEGDES MLRMFR
  406. SEGDES MLRCHE
  407. C
  408. SEGSUP MLRYIN
  409. SEGSUP MLRYFI
  410. SEGSUP SUMCV
  411. C
  412. RETURN
  413. END
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  

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