Télécharger pridem.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIDEM SOURCE CB215821 19/07/31 21:16:32 10277
  2. SUBROUTINE PRIDEM()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRIDEM
  8. C
  9. C DESCRIPTION : Voir PRIMIT
  10. C
  11. C RDEM approach for combustion.
  12. C Computation of the primitive variables.
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (Calcul) : PRIDE1
  22. C
  23. C
  24. C************************************************************************
  25. C
  26. C
  27. C CALL (GIBIANE) :
  28. C
  29. C RCHV1 RCHV2 RCHP1 RCHP2 RCHT1 RCHT2 = 'PRIM' 'DEM' TABPGAS
  30. C CHPAL1 CHPAL2 CHPARN1 CHPARN2 CHPAGN1 CHPAGN2
  31. C CHPARET1 CHPARET2 CHPTGUE1 CHPTGUE2 EPS ;
  32. C
  33. C
  34. C ENTREES :
  35. C
  36. C
  37. C TABPGAS : TABLE which contains
  38. C * 'SPECIES'
  39. C * 'CHEM_COEF'
  40. C * 'MASSFRA' initial and final mass fraction of
  41. C the first appearing in 'SPECIES',
  42. C final mass fractions of the species with
  43. C positive coefficients in 'CHEM_COEF',
  44. C initial mass fractions for the species with
  45. C negative coefficients in 'CHEM_COEF'
  46. C * 'RUNIV' = universal gas constant,
  47. C * ESPi = table containing the properties of
  48. C the species ESPi
  49. C * 'TMAX' maximum temperature for cv expansion;
  50. C for T>'TMAX', cv(T)=cv('TMAX')
  51. C * ESPI . 'A'
  52. C CV_i = \sum_{j=0,k} A_{i,j} T^j
  53. C * ESPI . 'W' (Kg/mole)
  54. C * ESPI . 'H0K'
  55. C e_{0,i} = h_{0,i} = h_{T_0,i} - {R_i * T_0 +
  56. C {\sum_{j=0,k} A_{i,j} / (j+1) T_0^(j+1)}};
  57. C
  58. C CHPAL1 : CHPOINT which contains the volume fraction alpha_1
  59. C of 1 (one component, 'SCAL').
  60. C
  61. C CHPAL2 : CHPOINT which contains the volume fraction alpha_2
  62. C of 2 (one component, 'SCAL').
  63. C
  64. C CHPARN1 : CHPOINT which contains the alpha_1 * density of 1
  65. C (one component, 'SCAL').
  66. C
  67. C CHPARN2 : CHPOINT which contains the alpha_2 * density of 2
  68. C (one component, 'SCAL').
  69. C
  70. C CHPAGN1 : CHPOINT which contains the alpha_1 * momentom of 1
  71. C (one component, 'SCAL').
  72. C
  73. C CHPAGN2 : CHPOINT which contains the alpha_2 * momentom of 2
  74. C (one component, 'SCAL').
  75. C
  76. C CHPARET1: CHPOINT which contains the alpha_1 * total energy
  77. C of 1 (one component, 'SCAL').
  78. C
  79. C CHPARET2: CHPOINT which contains the alpha_2 * total energy
  80. C of 2 (one component, 'SCAL').
  81. C
  82. C CHPTGUE1: CHPOINT which contains the guess value
  83. C for the temperature of 1 (one component, 'SCAL').
  84. C
  85. C CHPTGUE2: CHPOINT which contains the guess value
  86. C for the temperature of 2 (one component, 'SCAL').
  87. C
  88. C K0 : FLOTTANT which contains the fundamental flame
  89. C speed
  90. C
  91. C EPS : FLOTTANT such that if ALPHA_i < EPS, we can say
  92. C that species i does not exists
  93. C
  94. C
  95. C SORTIES :
  96. C
  97. C RCHV1 : CHPOINT which contains the speed of 1
  98. C
  99. C RCHV2 : CHPOINT which contains the speed of 2
  100. C
  101. C RCHP1 : CHPOINT which contains the pressure of 1
  102. C
  103. C RCHP2 : CHPOINT which contains the pressure of 2
  104. C
  105. C RCHT1 : CHPOINT which contains the temperature of 1
  106. C
  107. C RCHT2 : CHPOINT which contains the temperature of 2
  108. C
  109. C
  110. C************************************************************************
  111. C
  112. C HISTORIQUE : Crée le 06.09.09.
  113. C
  114. C************************************************************************
  115. C
  116. C
  117. C**** Les variables
  118. C
  119. IMPLICIT INTEGER(I-N)
  120. INTEGER ICOND, IRETOU, INDIC, NBCOMP
  121. & , NESP, NESP1, ICEN, IALP1, IALP2
  122. & , IARN1, IARN2
  123. & , IAGN1, IAGN2, IARET1, IARET2, ITG1, ITG2
  124. & , IPGAS, IESP
  125. & , IVN1, IVN2, IPN1, IPN2, IRN1, IRN2, ITN1, ITN2
  126. & , I1, I2, JGM, JGN, NORD, NORDP1, NORD1
  127. REAL*8 VALER(2),VAL1,VAL2, TMAX, RUNIV, EPS
  128. CHARACTER*(40) MESERR(2),MESCEL
  129. CHARACTER*(8) TYPE
  130. CHARACTER*(4) MOT1(1)
  131. LOGICAL LOGNEG, LOGBOR, LOGAN, LOGNC, LOGIPG
  132. C
  133. C**** Variables en ACCTAB
  134. C
  135. INTEGER IVALI, IRETI,IVALR, IRETR
  136. REAL*8 XVALI, XVALR
  137. LOGICAL LOGII, LOGIR
  138. CHARACTER*(8) CHARR,MTYPI
  139. C
  140. C**** Segment des proprietes du gaz
  141. C
  142. SEGMENT PROPHY
  143. REAL*8 ACV(NORD+1,NESP), W(NESP), H0K(NESP)
  144. ENDSEGMENT
  145. C
  146. C**** Les Includes
  147. C
  148.  
  149. -INC PPARAM
  150. -INC CCOPTIO
  151. -INC SMCHPOI
  152. -INC SMLMOTS
  153. -INC SMLREEL
  154. POINTEUR MLMOSC.MLMOTS, MLMESP.MLMOTS
  155. POINTEUR MLRMFR.MLREEL, MLRCHE.MLREEL
  156. C
  157. C**** Initialisation des parametres d'erreur
  158. C
  159. LOGAN = .FALSE.
  160. LOGNEG = .FALSE.
  161. LOGBOR = .FALSE.
  162. LOGNC = .FALSE.
  163. LOGIPG = .FALSE.
  164. MESCEL = ' '
  165. MESERR(1) = MESCEL
  166. MESERR(2) = MESCEL
  167. MOTERR(1:40) = MESCEL(1:40)
  168. VALER(1) = 0.0D0
  169. VALER(2) = 0.0D0
  170. VAL1 = 0.0D0
  171. VAL2 = 0.0D0
  172. C
  173. C**** Initialisation des variables en ACCTAB
  174. C
  175. IVALI = 0
  176. IVALR = 0
  177. XVALI = 0.0D0
  178. XVALR = 0.0D0
  179. LOGII = .FALSE.
  180. LOGIR = .FALSE.
  181. IRETI = 0
  182. IRETR = 0
  183. CHARR = ' '
  184. C
  185. C**** Initialisation des MOT1(1) (noms des composantes)
  186. C
  187. MOT1(1) = ' '
  188. C
  189. C**** N.B. On veut lire les objets sequentiellement.
  190. C Donc on utilise QUETYP pour controler que
  191. C le type de l'objet soit le bon.
  192. C
  193. C**** Lecture de la table des proprietes du gaz
  194. C
  195. ICOND = 1
  196. CALL QUETYP(TYPE,ICOND,IRETOU)
  197. IF(IERR .NE. 0)GOTO 9999
  198. IF(TYPE .NE. 'TABLE ')THEN
  199. C
  200. C******* Message d'erreur standard
  201. C 37 2
  202. C On ne trouve pas d'objet de type %m1:8
  203. C
  204. MOTERR(1:8) = 'TABLE '
  205. CALL ERREUR(37)
  206. GOTO 9999
  207. ELSE
  208. ICOND = 1
  209. CALL LIROBJ(TYPE,IPGAS,ICOND,IRETOU)
  210. IF(IERR .NE. 0)GOTO 9999
  211. ENDIF
  212. C
  213. C**** Ordre des polynoms pour les cv_i
  214. C
  215. MTYPI = 'MOT '
  216. TYPE = ' '
  217. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
  218. & TYPE,NORD,XVALR,CHARR,LOGIR,IESP)
  219. IF(TYPE .NE. 'ENTIER ')THEN
  220. C
  221. C******* Message d'erreur standard
  222. C -301 0 %m1:40
  223. C
  224. MOTERR(1:40) = 'TAB1 . NORD = ??? '
  225. WRITE(IOIMP,*) MOTERR(1:40)
  226. C
  227. C******* Message d'erreur standard
  228. C 21 2
  229. C Données incompatibles
  230. C
  231. CALL ERREUR(21)
  232. GOTO 9999
  233. ENDIF
  234. NORDP1 = NORD + 1
  235. C
  236. C**** 'TMAX'
  237. C
  238. MTYPI = 'MOT '
  239. TYPE = ' '
  240. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'TMAX',LOGII,IRETI,
  241. & TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
  242. IF(TYPE .NE. 'FLOTTANT')THEN
  243. C
  244. C******* Message d'erreur standard
  245. C -301 0 %m1:40
  246. C
  247. MOTERR(1:40) = 'TAB1 . TMAX = ??? '
  248. WRITE(IOIMP,*) MOTERR(1:40)
  249. C
  250. C******* Message d'erreur standard
  251. C 21 2
  252. C Données incompatibles
  253. C
  254. CALL ERREUR(21)
  255. GOTO 9999
  256. ENDIF
  257. TMAX = XVALR
  258. C
  259. C**** 'RUNIV'
  260. C
  261. MTYPI = 'MOT '
  262. TYPE = ' '
  263. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'RUNIV',LOGII,IRETI,
  264. & TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
  265. IF(TYPE .NE. 'FLOTTANT')THEN
  266. C
  267. C******* Message d'erreur standard
  268. C -301 0 %m1:40
  269. C
  270. MOTERR(1:40) = 'TAB1 . RUNIV = ??? '
  271. WRITE(IOIMP,*) MOTERR(1:40)
  272. C
  273. C******* Message d'erreur standard
  274. C 21 2
  275. C Données incompatibles
  276. C
  277. CALL ERREUR(21)
  278. GOTO 9999
  279. ENDIF
  280. RUNIV = XVALR
  281. C
  282. C**** Les especes
  283. C
  284. TYPE = ' '
  285. CALL ACMO(IPGAS,'SPECIES',TYPE,MLMESP)
  286. IF(TYPE .NE. 'LISTMOTS')THEN
  287. C
  288. C******* Message d'erreur standard
  289. C -301 0 %m1:40
  290. C
  291. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  292. WRITE(IOIMP,*) MOTERR(1:40)
  293. C
  294. C******* Message d'erreur standard
  295. C 21 2
  296. C Données incompatibles
  297. C
  298. CALL ERREUR(21)
  299. GOTO 9999
  300. ELSE
  301. SEGACT MLMESP
  302. NESP = MLMESP.MOTS(/2)
  303. SEGDES MLMESP
  304. ENDIF
  305. C
  306. C**** 'MASSFRA'
  307. C
  308. TYPE = ' '
  309. CALL ACMO(IPGAS,'MASSFRA',TYPE,MLRMFR)
  310. IF(TYPE .NE. 'LISTREEL')THEN
  311. C
  312. C******* Message d'erreur standard
  313. C -301 0 %m1:40
  314. C
  315. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  316. WRITE(IOIMP,*) MOTERR(1:40)
  317. C
  318. C******* Message d'erreur standard
  319. C 21 2
  320. C Données incompatibles
  321. C
  322. CALL ERREUR(21)
  323. GOTO 9999
  324. ELSE
  325. SEGACT MLRMFR
  326. NESP1 = MLRMFR.PROG(/1)
  327. IF (NESP1 .NE. NESP) THEN
  328. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  329. WRITE(IOIMP,*) MOTERR(1:40)
  330. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  331. WRITE(IOIMP,*) MOTERR(1:40)
  332. C
  333. C******* Message d'erreur standard
  334. C 21 2
  335. C Données incompatibles
  336. C
  337. CALL ERREUR(21)
  338. GOTO 9999
  339. ENDIF
  340. SEGDES MLRMFR
  341. ENDIF
  342. C
  343. C**** 'CHEMCOEF'
  344. C
  345. TYPE = ' '
  346. CALL ACMO(IPGAS,'CHEMCOEF',TYPE,MLRCHE)
  347. IF(TYPE .NE. 'LISTREEL')THEN
  348. C
  349. C******* Message d'erreur standard
  350. C -301 0 %m1:40
  351. C
  352. write(*,*) TYPE
  353. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  354. WRITE(IOIMP,*) MOTERR(1:40)
  355. C
  356. C******* Message d'erreur standard
  357. C 21 2
  358. C Données incompatibles
  359. C
  360. CALL ERREUR(21)
  361. GOTO 9999
  362. ELSE
  363. SEGACT MLRCHE
  364. NESP1 = MLRCHE.PROG(/1)
  365. IF (NESP1 .NE. NESP) THEN
  366. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  367. WRITE(IOIMP,*) MOTERR(1:40)
  368. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  369. WRITE(IOIMP,*) MOTERR(1:40)
  370. C
  371. C******* Message d'erreur standard
  372. C 21 2
  373. C Données incompatibles
  374. C
  375. CALL ERREUR(21)
  376. GOTO 9999
  377. ENDIF
  378. SEGDES MLRCHE
  379. ENDIF
  380. C
  381. C**** On rempli les segment PROPHY
  382. C Ordre: IPGAS . 'SPECIES'
  383. C
  384. SEGINI PROPHY
  385. SEGACT MLMESP
  386. C
  387. C**** N.B. MOT1 est un CHARACTER*(4)
  388. C
  389. DO I1 = 1, NESP
  390. MOT1(1) = MLMESP.MOTS(I1)
  391. C
  392. C******* CALL ACMF(...) ne marche pas parce que on a
  393. C des blanches dans nos composantes
  394. C
  395. MTYPI = 'MOT '
  396. TYPE = ' '
  397. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  398. & TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
  399. C
  400. C******* En IESP a la table IPGAS.MOT1(1)
  401. C
  402. IF((IERR .NE. 0) .OR. (TYPE .NE. 'TABLE ')) THEN
  403.  
  404. C
  405. C********** Message d'erreur standard
  406. C -301 0 %m1:40
  407. C
  408. MOTERR = ' '
  409. MOTERR(1:7) = 'TAB1 . '
  410. MOTERR(8:11) = MOT1(1)
  411. MOTERR(13:17) = '= ???'
  412. WRITE(IOIMP,*) MOTERR(1:40)
  413. C
  414. C********** Message d'erreur standard
  415. C 21 2
  416. C Données incompatibles
  417. C
  418. CALL ERREUR(21)
  419. GOTO 9999
  420. ENDIF
  421. C
  422. C******* W
  423. C
  424. MTYPI = 'MOT '
  425. TYPE = ' '
  426. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'W' , LOGII,IRETI,
  427. & TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  428. IF((IERR .NE. 0) .OR. (TYPE .NE. 'FLOTTANT')) THEN
  429. C
  430. C********** Message d'erreur standard
  431. C -301 0 %m1:40
  432. C
  433. MOTERR = ' '
  434. MOTERR(1:7) = 'TAB1 . '
  435. MOTERR(8:11) = MOT1(1)
  436. MOTERR(13:23) = ' . W = ??? '
  437. WRITE(IOIMP,*) MOTERR(1:40)
  438. C
  439. C********** Message d'erreur standard
  440. C 21 2
  441. C Données incompatibles
  442. C
  443. CALL ERREUR(21)
  444. GOTO 9999
  445. ENDIF
  446. PROPHY.W(I1)=XVALR
  447. C
  448. C******* H0K
  449. C
  450. MTYPI = 'MOT '
  451. TYPE = ' '
  452. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
  453. & TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  454. IF((IERR .NE. 0) .OR. (TYPE .NE. 'FLOTTANT')) THEN
  455.  
  456. C
  457. C********** Message d'erreur standard
  458. C -301 0 %m1:40
  459. C
  460. MOTERR = ' '
  461. MOTERR(1:7) = 'TAB1 . '
  462. MOTERR(8:11) = MOT1(1)
  463. MOTERR(13:25) = ' . H0K = ??? '
  464. WRITE(IOIMP,*) MOTERR(1:40)
  465. C
  466. C********** Message d'erreur standard
  467. C 21 2
  468. C Données incompatibles
  469. C
  470. CALL ERREUR(21)
  471. GOTO 9999
  472. ENDIF
  473. PROPHY.H0K(I1)=XVALR
  474. C
  475. C******* A
  476. C
  477. MTYPI = 'MOT '
  478. TYPE = ' '
  479. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
  480. & TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  481. IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
  482.  
  483. C
  484. C********** Message d'erreur standard
  485. C -301 0 %m1:40
  486. C
  487. MOTERR = ' '
  488. MOTERR(1:7) = 'TAB1 . '
  489. MOTERR(8:11) = MOT1(1)
  490. MOTERR(13:23) = ' . A = ??? '
  491. WRITE(IOIMP,*) MOTERR(1:40)
  492. C
  493. C********** Message d'erreur standard
  494. C 21 2
  495. C Données incompatibles
  496. C
  497. CALL ERREUR(21)
  498. GOTO 9999
  499. ENDIF
  500. MLREEL = IRETR
  501. SEGACT MLREEL
  502. NORD1 = MLREEL.PROG(/1)
  503. IF(NORD1 .NE. NORDP1)THEN
  504. C
  505. C********** Message d'erreur standard
  506. C -301 0 %m1:40
  507. C
  508. MOTERR = ' '
  509. MOTERR(1:10) = 'DIME(TAB1.'
  510. MOTERR(11:14) = MOT1(1)
  511. MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
  512. WRITE(IOIMP,*) MOTERR(1:40)
  513. C
  514. C********** Message d'erreur standard
  515. C 21 2
  516. C Données incompatibles
  517. C
  518. CALL ERREUR(21)
  519. GOTO 9999
  520. ENDIF
  521.  
  522. C
  523. C******* Dans le calcul, c'est plus utile ACV dans la forme
  524. C ACV(exponente,espece)
  525. C
  526. DO I2 = 1, NORDP1
  527. PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
  528. ENDDO
  529. SEGDES MLREEL
  530. ENDDO
  531. SEGDES MLMESP
  532. C
  533. C**** La table IPGAS donc a ete controllee et PROPHY est rempli
  534. C
  535. C
  536. C**** Lecture du CHPOINT ALPHA1
  537. C
  538. TYPE='CHPOINT '
  539. ICOND = 1
  540. CALL LIROBJ(TYPE,IALP1,ICOND,IRETOU)
  541. IF(IERR .NE. 0)GOTO 9999
  542. C
  543. C**** On cherche le pointeur de son maillage et on l'impose sur les
  544. C autres CHPOINTs
  545. C
  546. MCHPOI = IALP1
  547. SEGACT MCHPOI
  548. MSOUPO = MCHPOI.IPCHP(1)
  549. SEGACT MSOUPO
  550. ICEN = MSOUPO.IGEOC
  551. SEGDES MSOUPO
  552. SEGDES MCHPOI
  553. C
  554. C**** Control du CHPOINT: QUEPOI
  555. C
  556. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  557. C N.B. Le CHPOINT peut changer de structure pour
  558. C avoir SPG = ICEN!!!!
  559. C INDIC = 0 -> on ne fait que verifier le support geometrique
  560. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  561. C
  562. C NBCOMP > 0 -> numero des composantes
  563. C
  564. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  565. C
  566. INDIC = 1
  567. NBCOMP = 1
  568. MOT1(1) = 'SCAL'
  569. CALL QUEPOI(IALP1, ICEN, INDIC, NBCOMP, MOT1)
  570. IF(IERR .NE. 0)THEN
  571. C
  572. C******** Message d'erreur standard
  573. C -301 0 %m1:40
  574. C
  575. MOTERR = 'IALP1 = ??? '
  576. WRITE(IOIMP,*) MOTERR(1:40)
  577.  
  578. GOTO 9999
  579. ENDIF
  580. C
  581. C**** Lecture du CHPOINT ALPHA2
  582. C
  583. TYPE='CHPOINT '
  584. ICOND = 1
  585. CALL LIROBJ(TYPE,IALP2,ICOND,IRETOU)
  586. C
  587. C**** Control du CHPOINT: QUEPOI
  588. C
  589. INDIC = 1
  590. NBCOMP = 1
  591. MOT1(1) = 'SCAL'
  592. CALL QUEPOI(IALP2, ICEN, INDIC, NBCOMP, MOT1)
  593. IF(IERR .NE. 0)THEN
  594. C
  595. C******** Message d'erreur standard
  596. C -301 0 %m1:40
  597. C
  598. MOTERR = 'IALP2 = ??? '
  599. WRITE(IOIMP,*) MOTERR(1:40)
  600.  
  601. GOTO 9999
  602. ENDIF
  603. C
  604. C**** Lecture du CHPOINT IARN1
  605. C
  606. ICOND = 1
  607. TYPE='CHPOINT '
  608. CALL LIROBJ(TYPE,IARN1,ICOND,IRETOU)
  609. C
  610. C**** Control du CHPOINT: QUEPOI
  611. C
  612. INDIC = 1
  613. NBCOMP = 1
  614. MOT1(1) = 'SCAL'
  615. CALL QUEPOI(IARN1, ICEN, INDIC, NBCOMP, MOT1)
  616. IF(IERR .NE. 0)THEN
  617. C
  618. C******** Message d'erreur standard
  619. C -301 0 %m1:40
  620. C
  621. MOTERR = 'IARN1 = ??? '
  622. WRITE(IOIMP,*) MOTERR(1:40)
  623.  
  624. GOTO 9999
  625. ENDIF
  626. C
  627. C**** Lecture du CHPOINT IARN2
  628. C
  629. ICOND = 1
  630. TYPE='CHPOINT '
  631. CALL LIROBJ(TYPE,IARN2,ICOND,IRETOU)
  632. IF(IERR .NE. 0)GOTO 9999
  633. C
  634. C**** Control du CHPOINT: QUEPOI
  635. C
  636. INDIC = 1
  637. NBCOMP = 1
  638. MOT1(1) = 'SCAL'
  639. CALL QUEPOI(IARN2, ICEN, INDIC, NBCOMP, MOT1)
  640. IF(IERR .NE. 0)THEN
  641. C
  642. C******** Message d'erreur standard
  643. C -301 0 %m1:40
  644. C
  645. MOTERR = 'IARN2 = ??? '
  646. WRITE(IOIMP,*) MOTERR(1:40)
  647.  
  648. GOTO 9999
  649. ENDIF
  650. C
  651. C**** Lecture du CHPOINT IAGN1 ( debits)
  652. C
  653. TYPE='CHPOINT '
  654. ICOND = 1
  655. CALL LIROBJ(TYPE,IAGN1,ICOND,IRETOU)
  656. IF(IERR .NE. 0)GOTO 9999
  657. C
  658. C**** Control du CHPOINT
  659. C
  660. JGN = 4
  661. JGM = IDIM
  662. SEGINI MLMOTS
  663. MLMOTS.MOTS(1) = 'UX '
  664. MLMOTS.MOTS(2) = 'UY '
  665. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  666. C
  667. C**** On controlle l'ordre de composantes de IAGN1
  668. C
  669. CALL QUEPO1(IAGN1, ICEN, MLMOTS)
  670. IF(IERR .NE. 0)THEN
  671. C
  672. C******** Message d'erreur standard
  673. C -301 0 %m1:40
  674. C
  675. MOTERR = 'IAGN1 = ??? '
  676. WRITE(IOIMP,*) MOTERR(1:40)
  677.  
  678. GOTO 9999
  679. ENDIF
  680. C
  681. C**** Lecture du CHPOINT IAGN2 ( debits)
  682. C
  683. ICOND = 1
  684. TYPE='CHPOINT '
  685. CALL LIROBJ(TYPE,IAGN2,ICOND,IRETOU)
  686. IF(IERR .NE. 0)GOTO 9999
  687. C
  688. C**** Control du CHPOINT
  689. C
  690. JGN = 4
  691. JGM = IDIM
  692. SEGINI MLMOTS
  693. MLMOTS.MOTS(1) = 'UX '
  694. MLMOTS.MOTS(2) = 'UY '
  695. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  696. C
  697. C**** On controlle l'ordre de composantes de IAGN2
  698. C
  699. CALL QUEPO1(IAGN2, ICEN, MLMOTS)
  700. IF(IERR .NE. 0)THEN
  701. C
  702. C******** Message d'erreur standard
  703. C -301 0 %m1:40
  704. C
  705. MOTERR = 'IAGN2 = ??? '
  706. WRITE(IOIMP,*) MOTERR(1:40)
  707.  
  708. GOTO 9999
  709. ENDIF
  710. C
  711. C**** Lecture du CHPOINT IARET1
  712. C
  713. ICOND = 1
  714. TYPE='CHPOINT '
  715. CALL LIROBJ(TYPE,IARET1,ICOND,IRETOU)
  716. IF(IERR .NE. 0)GOTO 9999
  717. C
  718. C**** Control du CHPOINT: QUEPOI
  719. C
  720. INDIC = 1
  721. NBCOMP = 1
  722. MOT1(1) = 'SCAL'
  723. CALL QUEPOI(IARET1, ICEN, INDIC, NBCOMP, MOT1)
  724. IF(IERR .NE. 0)THEN
  725. C
  726. C******** Message d'erreur standard
  727. C -301 0 %m1:40
  728. C
  729. MOTERR = 'IARET1 = ??? '
  730. WRITE(IOIMP,*) MOTERR(1:40)
  731.  
  732. GOTO 9999
  733. ENDIF
  734. C
  735. C**** Lecture du CHPOINT IARET2
  736. C
  737. ICOND = 1
  738. TYPE='CHPOINT '
  739. CALL LIROBJ(TYPE,IARET2,ICOND,IRETOU)
  740. IF(IERR .NE. 0)GOTO 9999
  741. C
  742. C**** Control du CHPOINT: QUEPOI
  743. C
  744. INDIC = 1
  745. NBCOMP = 1
  746. MOT1(1) = 'SCAL'
  747. CALL QUEPOI(IARET2, ICEN, INDIC, NBCOMP, MOT1)
  748. IF(IERR .NE. 0)THEN
  749. C
  750. C******** Message d'erreur standard
  751. C -301 0 %m1:40
  752. C
  753. MOTERR = 'IARET2 = ??? '
  754. WRITE(IOIMP,*) MOTERR(1:40)
  755.  
  756. GOTO 9999
  757. ENDIF
  758. C
  759. C**** Lecture du CHPOINT Tguess ITG1
  760. C
  761. ICOND = 1
  762. TYPE = 'CHPOINT '
  763. CALL LIROBJ(TYPE,ITG1,ICOND,IRETOU)
  764. IF(IERR .NE. 0)GOTO 9999
  765. C
  766. C****** Control du CHPOINT
  767. C
  768. INDIC = 1
  769. NBCOMP = 1
  770. MOT1(1) = 'SCAL'
  771. CALL QUEPOI(ITG1, ICEN, INDIC, NBCOMP, MOT1)
  772. IF(IERR .NE. 0)THEN
  773. C
  774. C******* Message d'erreur standard
  775. C -301 0 %m1:40
  776. C
  777. MOTERR = 'ITG1 = ??? '
  778. WRITE(IOIMP,*) MOTERR(1:40)
  779. GOTO 9999
  780. ENDIF
  781. C
  782. C**** Lecture du CHPOINT Tguess ITG2
  783. C
  784. ICOND = 1
  785. TYPE='CHPOINT '
  786. CALL LIROBJ(TYPE,ITG2,ICOND,IRETOU)
  787. IF(IERR .NE. 0)GOTO 9999
  788. C
  789. C**** Control du CHPOINT: QUEPOI
  790. C
  791. INDIC = 1
  792. NBCOMP = 1
  793. MOT1(1) = 'SCAL'
  794. CALL QUEPOI(ITG2, ICEN, INDIC, NBCOMP, MOT1)
  795. IF(IERR .NE. 0)THEN
  796. C
  797. C******** Message d'erreur standard
  798. C -301 0 %m1:40
  799. C
  800. MOTERR = 'ITG2 = ??? '
  801. WRITE(IOIMP,*) MOTERR(1:40)
  802. GOTO 9999
  803. ENDIF
  804. C
  805. ICOND = 1
  806. CALL LIRREE(EPS, ICOND, IRETOU)
  807. IF(IERR .NE. 0)GOTO 9999
  808. C
  809. C**** Creation of the CHAMPOIN for the results
  810. C
  811. TYPE = 'CHPOINT '
  812. CALL KRCHP1(TYPE, ICEN, IVN1, MLMOTS)
  813. CALL KRCHP1(TYPE, ICEN, IVN2, MLMOTS)
  814. SEGSUP MLMOTS
  815. JGN = 4
  816. JGM = 1
  817. SEGINI MLMOTS
  818. MLMOTS.MOTS(1) = 'SCAL'
  819. CALL KRCHP1(TYPE, ICEN, IPN1, MLMOTS)
  820. CALL KRCHP1(TYPE, ICEN, IPN2, MLMOTS)
  821. CALL KRCHP1(TYPE, ICEN, IRN1, MLMOTS)
  822. CALL KRCHP1(TYPE, ICEN, IRN2, MLMOTS)
  823. CALL KRCHP1(TYPE, ICEN, ITN1, MLMOTS)
  824. CALL KRCHP1(TYPE, ICEN, ITN2, MLMOTS)
  825. SEGSUP MLMOTS
  826. C
  827. C**** Computation of the primitive variables
  828. C
  829. CALL PRIDE1(NESP,NORD,TMAX,RUNIV,PROPHY,
  830. & MLRCHE,MLRMFR,
  831. & ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2,
  832. & ITG1,ITG2,IRN1,IRN2,
  833. & IVN1,IVN2,IPN1,IPN2,ITN1,ITN2,
  834. & EPS,
  835. & LOGAN,LOGIPG,LOGNEG,LOGBOR,LOGNC,
  836. & VALER,VAL1,VAL2)
  837. C
  838. IF(IERR .NE. 0)THEN
  839. WRITE(IOIMP,*) 'subroutine pride1'
  840. GOTO 9999
  841. ENDIF
  842. CCCC
  843. CCCC**** Calcul des sorties.
  844. CCCC
  845. CCCC Jusque a la NESP = nombre d'especes qui apparessent
  846. CCCC dans les equations d'Euler
  847. CCCC
  848. CCCC Maintenant NESP = nombre total d'espece
  849. CCCC
  850. CCC NESP = NESP + 1
  851. CCC CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
  852. CCC & ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
  853. CCC & IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
  854. CCC & LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
  855. CCC & VALER,VAL1,VAL2)
  856. CCCC
  857. IF(LOGAN)THEN
  858. C
  859. C******* Message d'erreur standard
  860. C 5 3
  861. C Erreur anormale.contactez votre support
  862. C
  863. CALL ERREUR(5)
  864. GOTO 9999
  865. ELSE
  866. IF(LOGIPG)THEN
  867. C
  868. C********** CV(T) < 0
  869. C
  870. C
  871. C********** Message d'erreur standard
  872. C -301 0 %m1:40
  873. C
  874. MOTERR(1:40) = 'cv(T) < 0 ? R < 0 ? '
  875. WRITE(IOIMP,*) MOTERR(1:40)
  876. MOTERR(1:40) = 'TAB1 = ??? '
  877. WRITE(IOIMP,*) MOTERR(1:40)
  878. C
  879. C********** Message d'erreur standard
  880. C 21 2
  881. C Données incompatibles
  882. C
  883. CALL ERREUR(21)
  884. C IF(LOGTRI)THEN
  885. C IERR = 0
  886. C ELSE
  887. GOTO 9999
  888. C ENDIF
  889. ENDIF
  890. IF(LOGNC)THEN
  891. C
  892. C********** Newton - Raphson ne converge pas !!!
  893. C
  894. C
  895. C********** Message d'erreur standard
  896. C -301 0 %m1:40
  897. C
  898. MOTERR(1:40) = 'Newton - Raphson '
  899. WRITE(IOIMP,*) MOTERR(1:40)
  900. C
  901. C********** Message d'erreur standard
  902. C 460 2
  903. C Pas de convergence dans les itérations internes
  904. C
  905. CALL ERREUR(460)
  906. GOTO 9999
  907. ENDIF
  908. IF(LOGNEG)THEN
  909. C
  910. C******* Pression (energie thermique) ou densité negative
  911. C
  912. C
  913. C******* Message d'erreur standard
  914. C 41 2
  915. C %m1:8 = %r1 inférieur à %r2
  916. C
  917. MESCEL = MESERR(1)
  918. MOTERR(1:8) = MESCEL(1:8)
  919. REAERR(1) = REAL(VALER(1))
  920. REAERR(2) = 0.0
  921. CALL ERREUR(41)
  922. GOTO 9999
  923. ENDIF
  924. IF(LOGBOR)THEN
  925. C
  926. C ou Y !\in YMIN,YMAX
  927. C
  928. C******* Message d'erreur standard
  929. C 42 2
  930. C %m1:8 = %r1 non compris entre %r2 et %r3
  931. C
  932. MESCEL = MESERR(2)
  933. MOTERR(1:8) = MESCEL(1:8)
  934. REAERR(1) = REAL(VALER(2))
  935. REAERR(2) = REAL(VAL1)
  936. REAERR(3) = REAL(VAL2)
  937. CALL ERREUR(42)
  938. C We artificially change the value of IERR in order to
  939. C continue the computation
  940. IERR = 0
  941. GOTO 9999
  942. ENDIF
  943. ENDIF
  944. C
  945. C*****Ecriture du CHPOINT contenant les "gamma".
  946. C
  947. CALL ACTOBJ('CHPOINT ',ITN2,1)
  948. CALL ACTOBJ('CHPOINT ',ITN1,1)
  949. CALL ACTOBJ('CHPOINT ',IPN2,1)
  950. CALL ACTOBJ('CHPOINT ',IPN1,1)
  951. CALL ACTOBJ('CHPOINT ',IVN2,1)
  952. CALL ACTOBJ('CHPOINT ',IVN1,1)
  953. CALL ACTOBJ('CHPOINT ',IRN2,1)
  954. CALL ACTOBJ('CHPOINT ',IRN1,1)
  955.  
  956. CALL ECROBJ('CHPOINT ',ITN2)
  957. CALL ECROBJ('CHPOINT ',ITN1)
  958. CALL ECROBJ('CHPOINT ',IPN2)
  959. CALL ECROBJ('CHPOINT ',IPN1)
  960. CALL ECROBJ('CHPOINT ',IVN2)
  961. CALL ECROBJ('CHPOINT ',IVN1)
  962. CALL ECROBJ('CHPOINT ',IRN2)
  963. CALL ECROBJ('CHPOINT ',IRN1)
  964. 9999 CONTINUE
  965. C
  966. RETURN
  967. END
  968.  
  969.  
  970.  

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