Télécharger pridem.eso

Retour à la liste

Numérotation des lignes :

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

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