Télécharger konv13.eso

Retour à la liste

Numérotation des lignes :

  1. C KONV13 SOURCE BECC 11/06/08 21:15:41 7000
  2. SUBROUTINE KONV13
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : KONV13
  8. C
  9. C DESCRIPTION : Subroutine appellée par KONV1
  10. C
  11. C Modelisation 2D/3D des equations d'Euler.
  12. C Discrete Equation Method for combustion.
  13. C
  14. C Calcul du residu / jacobien / DELTAT
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  19. C
  20. C************************************************************************
  21. C
  22. C APPELES (Calcul) : KDEM12 (2D, gaz "thermally perfect", DEM)
  23. C
  24. C************************************************************************
  25. C
  26. C*** SINTAXE
  27. C
  28. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  29. C un gaz parfait mono-constituent. Methode DEM.
  30. C Inconnues: alpha, densité, quantité de mouvement, énergie totale par
  31. C unité de volume (variables conservatives)
  32. C
  33. C RCHPO1 RFLOT1 SURF1 = 'KONV' 'VF' 'DEM' MOT1 MOT2 MOD1 TABPG
  34. C LMOT1 MCHAA1 MCHAA2 ICHPK0 GRALP1 EPS
  35. C MAILLIM ;
  36. C ENTREES
  37. C
  38. C
  39. C MOT1 : objet de type MOT
  40. C Il vaut 'RESI' si on veut calculer le résidu
  41. C
  42. C MOT2 : objet de type MOT
  43. C Il indique la méthode de décentrement:
  44. C 'SS = solveur choc-choc
  45. C
  46. C MOD1 : objet modele de type Navier_Stokes
  47. C
  48. C TABG : objet de type TABLE
  49. C il contient les proprietes du gaz:
  50. C
  51. C LMOT1 : objet de type LISTMOTS
  52. C Noms de composantes du résultat (RCHPO1)
  53. C Il contient dans l'ordre suivant: le noms de alpha,
  54. C de la densité,
  55. C de la vitesse, de l'énergie totale par unité de volume
  56. C
  57. C MCHAA1 : MCHAML contenant la fraction volumique alpha de la phase 1,
  58. C qui a comme SPG (support géométrique) l'indice 'FACEL' de la
  59. C table associée à MOD1 (une composante, 'SCAL')
  60. C
  61. C MCHAA2 : MCHAML contenant la fraction volumique alpha de la phase 2,
  62. C même SPG que MCHAA1, une composante, 'SCAL'
  63. C
  64. C MCHAR1 : MCHAML contenant la masse volumique de la phase 1,
  65. C même SPG que MCHAA1, une composante, 'SCAL'
  66. C
  67. C MCHAR2 : MCHAML contenant la masse volumique de la phase 2,
  68. C même SPG que MCHAA1, une composante, 'SCAL'
  69. C
  70. C MCHAV1 : MCHAML contenant la vitesse de la phase 1 et les cosinus
  71. C directeurs du repère locale (n,t) dans le repère
  72. C global (x,y), même SPG que MCHAA1,
  73. C (dans le cas 2D 6 composantes:
  74. C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
  75. C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
  76. C * 'NX' = n.x (SPG = 'FACE')
  77. C * 'NY' = n.y (SPG = 'FACE')
  78. C * 'TX' = t.x (SPG = 'FACE')
  79. C * 'TY' = t.y (SPG = 'FACE')).
  80. C
  81. C MCHAV2 : MCHAML contenant la vitesse de la phase 1 et les cosinus
  82. C directeurs du repère locale (n,t) dans le repère
  83. C global (x,y), même SPG que MCHAA1,
  84. C (dans le cas 2D 6 composantes:
  85. C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
  86. C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
  87. C * 'NX' = n.x (SPG = 'FACE')
  88. C * 'NY' = n.y (SPG = 'FACE')
  89. C * 'TX' = t.x (SPG = 'FACE')
  90. C * 'TY' = t.y (SPG = 'FACE')).
  91. C
  92. C MCHAP1 : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression de
  93. C la phase 1 (une seule composante, 'SCAL').
  94. C
  95. C MCHAP2 : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression de
  96. C la phase 2 (une seule composante, 'SCAL').
  97. C
  98. C K0 : CHPOINT, fundamental flame speed
  99. C
  100. C GRALP1 : CHPOINT, grad(alp1)/|grad(alp1)|
  101. C
  102. C EPSILON : FLOTTANT t.q. a < EPSILON => a = 0
  103. C
  104. C MAILLIM : MAILLAGE -- describes the mesh where the flux is not
  105. C determined; it will be found by using
  106. C the subroutins for the Boundary Conditions
  107. C
  108. C SORTIES
  109. C
  110. C RCHPO1 : objet de type CHPOINT (composantes = LMOT1)
  111. C Residu si MOT2 = 'RESI' (SPG =('DOMA' MOD1 'CENTRE'))
  112. C
  113. C RFLOT1 : objet de type FLOTTANT
  114. C Il est le temps caracteristique associé à l'onde la plus
  115. C rapide.
  116. C
  117. C SURF1 : objet de type FLOTTANT
  118. C Surface de combustion
  119. C
  120. C Remarque
  121. C --------
  122. C
  123. C RCHPO1 est égal à:
  124. C * la derivé temporelle des inconnues si l'option 'RESI' est utilisée
  125. C
  126. C
  127. C***********************************************************************
  128. C
  129. C************************************************************************
  130. C
  131. C HISTORIQUE (Anomalies et modifications éventuelles)
  132. C
  133. C 07/12/2009 - Created
  134. C 21/12/2010 - Estension au 3D
  135. C
  136. C************************************************************************
  137. C
  138. IMPLICIT INTEGER(I-N)
  139. C
  140. -INC CCOPTIO
  141. -INC SMLMOTS
  142. POINTEUR MLMVIT.MLMOTS, MLMOEU.MLMOTS, MLMOSC.MLMOTS,
  143. $ MLMESP.MLMOTS
  144. -INC SMLREEL
  145. POINTEUR MLRMFR.MLREEL, MLRCHE.MLREEL
  146. -INC SMELEME
  147. C
  148. INTEGER IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
  149. & , INORM, MELLIM, IFLIM
  150. & , NBMET, INDMET, IRET, INDK0
  151. & , IPGAS, NORD, NORDP1, NESP, IESP
  152. & , JGM, JGN
  153. & , I1, I2
  154. & , INDIC, NBCOMP
  155. & , IALP1, IALP2
  156. & , IALF1, IROF1, IVITF1, IPF1
  157. & , IALF2, IROF2, IVITF2, IPF2
  158. & , IGRALP
  159. & , ICHPK0
  160. & , NINC, ILIINC, NC, ICELL
  161. & , ICHRES, INEFMD, ICOND, MMODEL
  162. & , ITOTO, NORD1, NESP1
  163. & , N1, N2
  164. & , IUINF1, IUINF2
  165. REAL*8 RUNIV, TMAX, EPS, K0
  166. C
  167. C**** Variables en ACCTAB
  168. C
  169. INTEGER IVALI, IRETI,IVALR, IRETR
  170. REAL*8 XVALI, XVALR
  171. LOGICAL LOGII, LOGIR
  172. CHARACTER*(8) MTYPI, MTYPR, CHARR
  173. C
  174. C**** Segment des proprietes du gaz
  175. C
  176. SEGMENT PROPHY
  177. REAL*8 XTAB(N1,N2)
  178. C REAL*8 ACV(NORDP1,NESP+1), W(NESP+1), H0K(NESP+1)
  179. C & ,ACVTOG(NORDP1), ACVTOD(NORDP1)
  180. ENDSEGMENT
  181. C
  182. PARAMETER (NBMET=3)
  183. REAL*8 DT, SURFL
  184. CHARACTER*8 LMETO(NBMET), TYPE
  185. CHARACTER*4 LFLUX(1), MOT1(1), LK0(2)
  186. CHARACTER*(40) MESERR
  187. LOGICAL LOGNC, LOGAN, LOGRES
  188. C
  189. DATA LMETO/'VLH ','SS ','AUSMPUP '/
  190. DATA LFLUX/'RESI'/
  191. DATA LK0/'CONS','VARI'/
  192. C
  193. C**** Initialisation des variables pour la gestion des erreurs.
  194. C
  195. LOGNC = .FALSE.
  196. LOGAN = .FALSE.
  197. MESERR = ' '
  198. C
  199. C******* Flux ou residu???
  200. C
  201. CALL LIRMOT(LFLUX,1,ICELL,1)
  202. IF(IERR .NE. 0)GOTO 9999
  203. IF(ICELL .NE. 1)THEN
  204. C LOGRES = .TRUE.
  205. C ELSE
  206. C
  207. C******** Message d'erreur standard
  208. C 251 2
  209. C Tentative d'utilisation d'une option non implémentée
  210. C
  211. CALL ERREUR(251)
  212. ENDIF
  213. C
  214. C**** Metode utilisée
  215. C
  216. CALL LIRMOT(LMETO,NBMET,INDMET,1)
  217. IF(IERR .NE. 0)GOTO 9999
  218. IF(INDMET .EQ. 0)THEN
  219. C
  220. C******** Message d'erreur standard
  221. C 251 2
  222. C Tentative d'utilisation d'une option non implémentée
  223. C
  224. CALL ERREUR(251)
  225. ENDIF
  226. C
  227. C**** KO constant ou variable ???
  228. C
  229. CALL LIRMOT(LK0,2,INDK0,1)
  230. IF(IERR .NE. 0)GOTO 9999
  231. IF(INDK0 .EQ. 0)THEN
  232. C
  233. C******** Message d'erreur standard
  234. C 251 2
  235. C Tentative d'utilisation d'une option non implémentée
  236. C
  237. CALL ERREUR(251)
  238. ENDIF
  239. C
  240. C**********************************
  241. C**** Lecture de l'objet MODELE ***
  242. C**********************************
  243. C
  244. ICOND = 1
  245. CALL QUETYP(TYPE,ICOND,IRET)
  246.  
  247. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  248. WRITE(IOIMP,*)' On attend un objet MMODEL'
  249. RETURN
  250. ENDIF
  251. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  252. IF(IERR.NE.0)GOTO 9999
  253. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  254. IF(IERR.NE.0)GOTO 9999
  255. C
  256. C**** Centre, FACE et FACEL
  257. C
  258. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  259. IF(IERR .NE. 0) GOTO 9999
  260. C
  261. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  262. IF(IERR .NE. 0) GOTO 9999
  263. C
  264. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  265. IF(IERR .NE. 0) GOTO 9999
  266. C
  267. C**** Lecture du CHPOINT contenant les surfaces des faces.
  268. C
  269. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  270. IF(IERR .NE. 0) GOTO 9999
  271. C
  272. C**** Lecture du CHPOINT contenant les diametres minimums.
  273. C
  274. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  275. IF(IERR .NE. 0) GOTO 9999
  276. C
  277. C**** Lecture du CHPOINT contenant les volumes
  278. C
  279. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  280. IF(IERR .NE. 0) GOTO 9999
  281. C
  282. C********** Les normales aux faces
  283. C
  284. IF(IDIM .EQ. 2)THEN
  285. C Que les normales
  286. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  287. IF(IERR .NE. 0) GOTO 9999
  288. JGN = 4
  289. JGM = 2
  290. SEGINI MLMVIT
  291. MLMVIT.MOTS(1) = 'UX '
  292. MLMVIT.MOTS(2) = 'UY '
  293. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  294. SEGSUP MLMVIT
  295. IF(IERR .NE. 0) GOTO 9999
  296. ELSE
  297. C Les normales et les tangentes
  298. TYPE = ' '
  299. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  300. IF (TYPE .NE. 'CHPOINT ') THEN
  301. CALL MATRAN(IDOMA,INORM)
  302. IF(IERR .NE. 0) GOTO 9999
  303. ENDIF
  304. JGN = 4
  305. JGM = 9
  306. SEGINI MLMVIT
  307. MLMVIT.MOTS(1) = 'UX '
  308. MLMVIT.MOTS(2) = 'UY '
  309. MLMVIT.MOTS(3) = 'UZ '
  310. MLMVIT.MOTS(4) = 'RX '
  311. MLMVIT.MOTS(5) = 'RY '
  312. MLMVIT.MOTS(6) = 'RZ '
  313. MLMVIT.MOTS(7) = 'MX '
  314. MLMVIT.MOTS(8) = 'MY '
  315. MLMVIT.MOTS(9) = 'MZ '
  316. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  317. SEGSUP MLMVIT
  318. ENDIF
  319. C
  320. C********************************
  321. C**** Fin table domaine *********
  322. C********************************
  323. C********************************
  324. C**** La table IPGAZ *******
  325. C********************************
  326. C
  327. C write(*,*) 'Son qui prima di ipgaz'
  328. C
  329. C**** Lecture de la table des proprietes du gaz
  330. C
  331. ICOND = 1
  332. CALL QUETYP(TYPE,ICOND,IRET)
  333. IF(IERR .NE. 0)GOTO 9999
  334. IF(TYPE .NE. 'TABLE ')THEN
  335. C
  336. C******* Message d'erreur standard
  337. C 37 2
  338. C On ne trouve pas d'objet de type %m1:8
  339. C
  340. MOTERR(1:8) = 'TABLE '
  341. CALL ERREUR(37)
  342. GOTO 9999
  343. ELSE
  344. ICOND = 1
  345. CALL LIROBJ(TYPE,IPGAS,ICOND,IRET)
  346. IF(IERR .NE. 0)GOTO 9999
  347. ENDIF
  348. C
  349. C**** Ordre des polynoms pour les cv_i
  350. C
  351. MTYPI = 'MOT '
  352. MTYPR = ' '
  353. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
  354. & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
  355. IF(MTYPR .NE. 'ENTIER ')THEN
  356. C
  357. C******* Message d'erreur standard
  358. C -301 0 %m1:40
  359. C
  360. MOTERR(1:40) = 'TAB1 . NORD = ??? '
  361. WRITE(IOIMP,*) MOTERR(1:40)
  362. C
  363. C******* Message d'erreur standard
  364. C 21 2
  365. C Données incompatibles
  366. C
  367. CALL ERREUR(21)
  368. GOTO 9999
  369. ENDIF
  370. NORDP1 = NORD + 1
  371. C
  372. C**** 'TMAX'
  373. C
  374. MTYPI = 'MOT '
  375. MTYPR = ' '
  376. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'TMAX',LOGII,IRETI,
  377. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  378. IF(MTYPR .NE. 'FLOTTANT')THEN
  379. C
  380. C******* Message d'erreur standard
  381. C -301 0 %m1:40
  382. C
  383. MOTERR(1:40) = 'TAB1 . TMAX = ??? '
  384. WRITE(IOIMP,*) MOTERR(1:40)
  385. C
  386. C******* Message d'erreur standard
  387. C 21 2
  388. C Données incompatibles
  389. C
  390. CALL ERREUR(21)
  391. GOTO 9999
  392. ENDIF
  393. TMAX = XVALR
  394. C
  395. C**** 'RUNIV'
  396. C
  397. MTYPI = 'MOT '
  398. MTYPR = ' '
  399. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'RUNIV',LOGII,IRETI,
  400. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  401. IF(MTYPR .NE. 'FLOTTANT')THEN
  402. C
  403. C******* Message d'erreur standard
  404. C -301 0 %m1:40
  405. C
  406. MOTERR(1:40) = 'TAB1 . RUNIV = ??? '
  407. WRITE(IOIMP,*) MOTERR(1:40)
  408. C
  409. C******* Message d'erreur standard
  410. C 21 2
  411. C Données incompatibles
  412. C
  413. CALL ERREUR(21)
  414. GOTO 9999
  415. ENDIF
  416. RUNIV = XVALR
  417. C
  418. C**** Les especes
  419. C
  420. MTYPR = ' '
  421. CALL ACMO(IPGAS,'SPECIES',MTYPR,MLMESP)
  422. IF(MTYPR .NE. 'LISTMOTS')THEN
  423. C
  424. C******* Message d'erreur standard
  425. C -301 0 %m1:40
  426. C
  427. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  428. WRITE(IOIMP,*) MOTERR(1:40)
  429. C
  430. C******* Message d'erreur standard
  431. C 21 2
  432. C Données incompatibles
  433. C
  434. CALL ERREUR(21)
  435. GOTO 9999
  436. ELSE
  437. SEGACT MLMESP
  438. NESP = MLMESP.MOTS(/2)
  439. SEGDES MLMESP
  440. ENDIF
  441. C
  442. C**** 'MASSFRA'
  443. C
  444. MTYPR = ' '
  445. CALL ACMO(IPGAS,'MASSFRA',MTYPR,MLRMFR)
  446. IF(MTYPR .NE. 'LISTREEL')THEN
  447. C
  448. C******* Message d'erreur standard
  449. C -301 0 %m1:40
  450. C
  451. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  452. WRITE(IOIMP,*) MOTERR(1:40)
  453. C
  454. C******* Message d'erreur standard
  455. C 21 2
  456. C Données incompatibles
  457. C
  458. CALL ERREUR(21)
  459. GOTO 9999
  460. ELSE
  461. SEGACT MLRMFR
  462. NESP1 = MLRMFR.PROG(/1)
  463. IF (NESP1 .NE. NESP) THEN
  464. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  465. WRITE(IOIMP,*) MOTERR(1:40)
  466. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  467. WRITE(IOIMP,*) MOTERR(1:40)
  468. C
  469. C******* Message d'erreur standard
  470. C 21 2
  471. C Données incompatibles
  472. C
  473. CALL ERREUR(21)
  474. GOTO 9999
  475. ENDIF
  476. SEGDES MLRMFR
  477. ENDIF
  478. C
  479. C**** 'CHEMCOEF'
  480. C
  481. MTYPR = ' '
  482. CALL ACMO(IPGAS,'CHEMCOEF',MTYPR,MLRCHE)
  483. IF(MTYPR .NE. 'LISTREEL')THEN
  484. C
  485. C******* Message d'erreur standard
  486. C -301 0 %m1:40
  487. C
  488. write(IOIMP,*) MTYPR
  489. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  490. WRITE(IOIMP,*) MOTERR(1:40)
  491. C
  492. C******* Message d'erreur standard
  493. C 21 2
  494. C Données incompatibles
  495. C
  496. CALL ERREUR(21)
  497. GOTO 9999
  498. ELSE
  499. SEGACT MLRCHE
  500. NESP1 = MLRCHE.PROG(/1)
  501. IF (NESP1 .NE. NESP) THEN
  502. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  503. WRITE(IOIMP,*) MOTERR(1:40)
  504. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  505. WRITE(IOIMP,*) MOTERR(1:40)
  506. C
  507. C******* Message d'erreur standard
  508. C 21 2
  509. C Données incompatibles
  510. C
  511. CALL ERREUR(21)
  512. GOTO 9999
  513. ENDIF
  514. SEGDES MLRCHE
  515. ENDIF
  516. C
  517. C**** On rempli les segment PROPHY
  518. C Ordre: IPGAS . 'SPECIES'
  519. C
  520. N1 = NORDP1 + 2
  521. N2 = NESP
  522. SEGINI PROPHY
  523. SEGACT MLMESP
  524. C
  525. C**** N.B. MOT1 est un CHARACTER*(4)
  526. C
  527. DO I1 = 1, NESP
  528. MOT1(1) = MLMESP.MOTS(I1)
  529. C
  530. C******* CALL ACMF(...) ne marche pas parce que on a
  531. C des blanches dans nos composantes
  532. C
  533. MTYPI = 'MOT '
  534. MTYPR = ' '
  535. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  536. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  537. C
  538. C******* En IESP a la table IPGAS.MOT1(1)
  539. C
  540. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
  541.  
  542. C
  543. C********** Message d'erreur standard
  544. C -301 0 %m1:40
  545. C
  546. MOTERR = ' '
  547. MOTERR(1:7) = 'TAB1 . '
  548. MOTERR(8:11) = MOT1(1)
  549. MOTERR(13:17) = '= ???'
  550. WRITE(IOIMP,*) MOTERR(1:40)
  551. C
  552. C********** Message d'erreur standard
  553. C 21 2
  554. C Données incompatibles
  555. C
  556. CALL ERREUR(21)
  557. GOTO 9999
  558. ENDIF
  559. C
  560. C******* W
  561. C
  562. MTYPI = 'MOT '
  563. MTYPR = ' '
  564. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'W' , LOGII,IRETI,
  565. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  566. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  567. C
  568. C********** Message d'erreur standard
  569. C -301 0 %m1:40
  570. C
  571. MOTERR = ' '
  572. MOTERR(1:7) = 'TAB1 . '
  573. MOTERR(8:11) = MOT1(1)
  574. MOTERR(13:23) = ' . W = ??? '
  575. WRITE(IOIMP,*) MOTERR(1:40)
  576. C
  577. C********** Message d'erreur standard
  578. C 21 2
  579. C Données incompatibles
  580. C
  581. CALL ERREUR(21)
  582. GOTO 9999
  583. ENDIF
  584. C PROPHY.W(I1)=XVALR
  585. PROPHY.XTAB(NORDP1+1,I1)=XVALR
  586. C
  587. C******* H0K
  588. C
  589. MTYPI = 'MOT '
  590. MTYPR = ' '
  591. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
  592. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  593. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  594.  
  595. C
  596. C********** Message d'erreur standard
  597. C -301 0 %m1:40
  598. C
  599. MOTERR = ' '
  600. MOTERR(1:7) = 'TAB1 . '
  601. MOTERR(8:11) = MOT1(1)
  602. MOTERR(13:25) = ' . H0K = ??? '
  603. WRITE(IOIMP,*) MOTERR(1:40)
  604. C
  605. C********** Message d'erreur standard
  606. C 21 2
  607. C Données incompatibles
  608. C
  609. CALL ERREUR(21)
  610. GOTO 9999
  611. ENDIF
  612. C PROPHY.H0K(I1)=XVALR
  613. PROPHY.XTAB(NORDP1+2,I1)=XVALR
  614. C
  615. C******* A
  616. C
  617. MTYPI = 'MOT '
  618. MTYPR = ' '
  619. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
  620. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  621. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
  622.  
  623. C
  624. C********** Message d'erreur standard
  625. C -301 0 %m1:40
  626. C
  627. MOTERR = ' '
  628. MOTERR(1:7) = 'TAB1 . '
  629. MOTERR(8:11) = MOT1(1)
  630. MOTERR(13:23) = ' . A = ??? '
  631. WRITE(IOIMP,*) MOTERR(1:40)
  632. C
  633. C********** Message d'erreur standard
  634. C 21 2
  635. C Données incompatibles
  636. C
  637. CALL ERREUR(21)
  638. GOTO 9999
  639. ENDIF
  640. MLREEL = IRETR
  641. SEGACT MLREEL
  642. NORD1 = MLREEL.PROG(/1)
  643. IF(NORD1 .NE. NORDP1)THEN
  644. C
  645. C********** Message d'erreur standard
  646. C -301 0 %m1:40
  647. C
  648. MOTERR = ' '
  649. MOTERR(1:10) = 'DIME(TAB1.'
  650. MOTERR(11:14) = MOT1(1)
  651. MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
  652. WRITE(IOIMP,*) MOTERR(1:40)
  653. C
  654. C********** Message d'erreur standard
  655. C 21 2
  656. C Données incompatibles
  657. C
  658. CALL ERREUR(21)
  659. GOTO 9999
  660. ENDIF
  661.  
  662. C
  663. C******* Dans le calcul, c'est plus utile ACV dans la forme
  664. C ACV(exponente,espece)
  665. C
  666. DO I2 = 1, NORDP1
  667. C PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
  668. PROPHY.XTAB(I2,I1) = MLREEL.PROG(I2)
  669. ENDDO
  670. SEGDES MLREEL
  671. ENDDO
  672. SEGDES MLMESP
  673. C
  674. C write(*,*) 'Son qui dopo ipgaz'
  675. C
  676. C**** La table IPGAZ donc a ete controllee et PROPHY est rempli
  677. C
  678. C
  679. C**** Lecture du CHPOINT ALPHA1
  680. C
  681. TYPE='CHPOINT '
  682. ICOND = 1
  683. CALL LIROBJ(TYPE,IALP1,ICOND,IRET)
  684. IF(IERR .NE. 0)GOTO 9999
  685. C
  686. C**** Control du CHPOINT: QUEPOI
  687. C
  688. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  689. C N.B. Le CHPOINT peut changer de structure pour
  690. C avoir SPG = ICEN!!!!
  691. C INDIC = 0 -> on ne fait que verifier le support geometrique
  692. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  693. C
  694. C NBCOMP > 0 -> numero des composantes
  695. C
  696. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  697. C
  698. INDIC = 1
  699. NBCOMP = 1
  700. MOT1(1) = 'SCAL'
  701. CALL QUEPOI(IALP1, MELEMC, INDIC, NBCOMP, MOT1)
  702. IF(IERR .NE. 0)THEN
  703. C
  704. C******** Message d'erreur standard
  705. C -301 0 %m1:40
  706. C
  707. MOTERR = 'IALP1 = ??? '
  708. WRITE(IOIMP,*) MOTERR(1:40)
  709. GOTO 9999
  710. ENDIF
  711. C
  712. C**** Lecture du CHPOINT ALPHA2
  713. C
  714. TYPE='CHPOINT '
  715. ICOND = 1
  716. CALL LIROBJ(TYPE,IALP2,ICOND,IRET)
  717. C
  718. C**** Control du CHPOINT: QUEPOI
  719. C
  720. INDIC = 1
  721. NBCOMP = 1
  722. MOT1(1) = 'SCAL'
  723. CALL QUEPOI(IALP2, MELEMC, 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 = 'IALP2 = ??? '
  730. WRITE(IOIMP,*) MOTERR(1:40)
  731. GOTO 9999
  732. ENDIF
  733. C
  734. C**** On va lire les pointeurs des MCHAMLs
  735. C Lecture du MCHAML 'FACEL' alpha
  736. C
  737. TYPE='MCHAML '
  738. CALL LIROBJ(TYPE,IALF1,1,IRET)
  739. IF(IERR.NE.0) GOTO 9999
  740. CALL LIROBJ(TYPE,IALF2,1,IRET)
  741. IF(IERR.NE.0) GOTO 9999
  742. C Lecture du MCHAML 'FACEL' densité
  743. C
  744. TYPE='MCHAML '
  745. CALL LIROBJ(TYPE,IROF1,1,IRET)
  746. IF(IERR.NE.0) GOTO 9999
  747. CALL LIROBJ(TYPE,IROF2,1,IRET)
  748. IF(IERR.NE.0) GOTO 9999
  749. C
  750. C**** Lecture du MCHAML 'FACEL' vitesse
  751. C
  752. TYPE='MCHAML '
  753. CALL LIROBJ(TYPE,IVITF1,1,IRET)
  754. IF(IERR .NE. 0) GOTO 9999
  755. CALL LIROBJ(TYPE,IVITF2,1,IRET)
  756. IF(IERR .NE. 0) GOTO 9999
  757. C
  758. C**** Lecture du MCHAML 'FACEL' contenant la pression
  759. C
  760. TYPE='MCHAML '
  761. CALL LIROBJ(TYPE,IPF1,1,IRET)
  762. IF(IERR .NE. 0) GOTO 9999
  763. CALL LIROBJ(TYPE,IPF2,1,IRET)
  764. IF(IERR .NE. 0) GOTO 9999
  765. C
  766. C**** Lecture du CHAMPOINT contenant grad(alpha)/|grad(alpha)|
  767. C
  768. TYPE='CHPOINT '
  769. ICOND = 1
  770. CALL LIROBJ(TYPE,IGRALP,ICOND,IRET)
  771. IF(IERR .NE. 0)GOTO 9999
  772. C
  773. C**** Control du CHPOINT
  774. C
  775. JGN = 4
  776. JGM = IDIM
  777. SEGINI MLMOTS
  778. MLMOTS.MOTS(1) = 'P1DX'
  779. MLMOTS.MOTS(2) = 'P1DY'
  780. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'P1DZ'
  781. C
  782. C**** On controlle l'ordre de composantes de IAGN1
  783. C
  784. CALL QUEPO1(IGRALP, MELEMF, MLMOTS)
  785. IF(IERR .NE. 0)THEN
  786. C
  787. C******** Message d'erreur standard
  788. C -301 0 %m1:40
  789. C
  790. MOTERR = 'GRAALP = ??? '
  791. WRITE(IOIMP,*) MOTERR(1:40)
  792.  
  793. GOTO 9999
  794. ENDIF
  795. SEGSUP MLMOTS
  796. C
  797. C**** NINC = nombre d'inconnues
  798. C
  799. NINC=(IDIM+3)*2
  800. C
  801. TYPE='LISTMOTS'
  802. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  803. IF(IERR .NE. 0) GOTO 9999
  804. MLMOTS = ILIINC
  805. SEGACT MLMOTS
  806. NC = MLMOTS.MOTS(/2)
  807. SEGDES MLMOTS
  808. IF(NC .NE. NINC)THEN
  809. MOTERR(1:40) = 'LISTINCO = ???'
  810. WRITE(IOIMP,*) MOTERR
  811. C
  812. C******* Message d'erreur standard
  813. C 21 2
  814. C Données incompatibles
  815. C
  816. CALL ERREUR(21)
  817. GOTO 9999
  818. ENDIF
  819. C
  820. C**** Lecture du CHAMPOINT ou du REEL contenant K0
  821. C
  822. IF (INDK0 .EQ. 1) THEN
  823. ICOND = 1
  824. CALL LIRREE(K0, ICOND, IRET)
  825. IF(IERR .NE. 0)GOTO 9999
  826. ELSE
  827. TYPE='CHPOINT '
  828. ICOND = 1
  829. CALL LIROBJ(TYPE,ICHPK0,ICOND,IRET)
  830. IF(IERR .NE. 0)GOTO 9999
  831. INDIC = 1
  832. NBCOMP = 1
  833. MOT1(1) = 'SCAL'
  834. CALL QUEPOI(ICHPK0, MELEMC, INDIC, NBCOMP, MOT1)
  835. IF(IERR .NE. 0) GOTO 9999
  836. ENDIF
  837. C
  838. C**** Lecture de EPS
  839. C
  840. ICOND = 1
  841. CALL LIRREE(EPS, ICOND, IRET)
  842. IF(IERR .NE. 0)GOTO 9999
  843. C
  844. C**** Boundary condition
  845. C
  846. IRET=0
  847. TYPE='MAILLAGE'
  848. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  849. IF(IERR.NE.0)GOTO 9999
  850. IF(IRET .EQ. 0)THEN
  851. MELLIM = 0
  852. ELSE
  853. MELEME=IFLIM
  854. SEGACT MELEME
  855. ITOTO=MELEME.NUM(/2)
  856. IF(ITOTO .EQ. 0)THEN
  857. MELLIM = 0
  858. ELSE
  859. MELLIM = IFLIM
  860. ENDIF
  861. SEGDES MELEME
  862. ENDIF
  863. C
  864. C**** Bas Mach (AUSMPUP)
  865. C
  866. IF(INDMET .EQ. 3) THEN
  867. TYPE = 'CHPOINT '
  868. C
  869. C******* Reference speed
  870. C
  871. CALL LIROBJ(TYPE,IUINF1,1,IRET)
  872. IF(IERR .NE. 0) GOTO 9999
  873. INDIC = 1
  874. NBCOMP = 1
  875. MOT1(1) = 'SCAL'
  876. CALL QUEPOI(IUINF1, MELEMC, INDIC, NBCOMP, MOT1)
  877. IF(IERR .NE. 0) GOTO 9999
  878. C
  879. C******* Minimal cutoff
  880. C
  881. TYPE = 'CHPOINT '
  882. CALL LIROBJ(TYPE,IUINF2,1,IRET)
  883. IF(IERR .NE. 0) GOTO 9999
  884. INDIC = 1
  885. NBCOMP = 1
  886. MOT1(1) = 'SCAL'
  887. CALL QUEPOI(IUINF2, MELEMC, INDIC, NBCOMP, MOT1)
  888. IF(IERR .NE. 0) GOTO 9999
  889. C
  890. ELSE
  891. IUINF1=0
  892. IUINF2=0
  893. ENDIF
  894. C
  895. C write(*,*) 'Son qui dopo la lettura degli inputs'
  896. C
  897. C**** Creation du residu
  898. C
  899. TYPE = 'CHPOINT '
  900. CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
  901. C
  902. C**** Calcul des flux et du pas du temps.
  903. C
  904. CALL KODFL1(INDK0,NESP,NORD,TMAX,RUNIV,PROPHY,
  905. & MLRCHE,MLRMFR,
  906. & INDMET,
  907. & IALP1, IALP2,
  908. & IALF1,IROF1,IVITF1,IPF1,
  909. & IALF2,IROF2,IVITF2,IPF2,
  910. & IUINF1, IUINF2,
  911. & K0,ICHPK0,
  912. & IGRALP,EPS,
  913. & ICHPSU,ICHPDI,ICHPVO,
  914. & MELEMC,MELEMF,MELEFE,MELLIM,
  915. & ICHRES,
  916. & DT,SURFL,
  917. & LOGNC,LOGAN,MESERR)
  918. C
  919. IF(LOGAN)THEN
  920. C
  921. C******* Anomalie detectée
  922. C
  923. C
  924. C******* Message d'erreur standard
  925. C -301 0
  926. C %m1:40
  927. C
  928. MOTERR(1:40) = MESERR(1:40)
  929. WRITE(IOIMP,*) MOTERR(1:40)
  930. C
  931. C******* Message d'erreur standard
  932. C 5 3
  933. C Erreur anormale.contactez votre support
  934. C
  935. CALL ERREUR(5)
  936. GOTO 9999
  937. ENDIF
  938. IF(LOGNC)THEN
  939. C
  940. C******* Message d'erreur standard
  941. C -301 0
  942. C %m1:40
  943. C
  944. MOTERR(1:40) = MESERR(1:40)
  945. WRITE(IOIMP,*) MOTERR(1:40)
  946. C
  947. C******* Message d'erreur standard
  948. C 460 2
  949. C Pas de convergence dans les itérations internes
  950. C
  951. CALL ERREUR(460)
  952. GOTO 9999
  953. ENDIF
  954. C
  955. C**** Ecriture des resultats
  956. C
  957. CALL ECRREE(SURFL)
  958. CALL ECRREE(DT)
  959. TYPE = 'CHPOINT '
  960. IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
  961. C
  962. SEGSUP PROPHY
  963. C
  964. 9999 CONTINUE
  965. RETURN
  966. END
  967.  
  968.  
  969.  
  970.  
  971.  
  972.  
  973.  
  974.  
  975.  
  976.  
  977.  
  978.  
  979.  
  980.  
  981.  
  982.  
  983.  
  984.  

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