Télécharger konv13.eso

Retour à la liste

Numérotation des lignes :

konv13
  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.  
  141. -INC PPARAM
  142. -INC CCOPTIO
  143. -INC SMLMOTS
  144. POINTEUR MLMVIT.MLMOTS, MLMOEU.MLMOTS, MLMOSC.MLMOTS,
  145. $ MLMESP.MLMOTS
  146. -INC SMLREEL
  147. POINTEUR MLRMFR.MLREEL, MLRCHE.MLREEL
  148. -INC SMELEME
  149. C
  150. INTEGER IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
  151. & , INORM, MELLIM, IFLIM
  152. & , NBMET, INDMET, IRET, INDK0
  153. & , IPGAS, NORD, NORDP1, NESP, IESP
  154. & , JGM, JGN
  155. & , I1, I2
  156. & , IALP1, IALP2
  157. & , IALF1, IROF1, IVITF1, IPF1
  158. & , IALF2, IROF2, IVITF2, IPF2
  159. & , IGRALP
  160. & , ICHPK0
  161. & , NINC, ILIINC, NC, ICELL
  162. & , ICHRES, INEFMD, ICOND, MMODEL
  163. & , ITOTO, NORD1, NESP1
  164. & , N1, N2
  165. & , IUINF1, IUINF2
  166. REAL*8 RUNIV, TMAX, EPS, K0
  167. C
  168. C**** Variables en ACCTAB
  169. C
  170. INTEGER IVALI, IRETI,IVALR, IRETR
  171. REAL*8 XVALI, XVALR
  172. LOGICAL LOGII, LOGIR
  173. CHARACTER*(8) MTYPI, MTYPR, CHARR
  174. C
  175. C**** Segment des proprietes du gaz
  176. C
  177. SEGMENT PROPHY
  178. REAL*8 XTAB(N1,N2)
  179. C REAL*8 ACV(NORDP1,NESP+1), W(NESP+1), H0K(NESP+1)
  180. C & ,ACVTOG(NORDP1), ACVTOD(NORDP1)
  181. ENDSEGMENT
  182. C
  183. PARAMETER (NBMET=3)
  184. REAL*8 DT, SURFL
  185. CHARACTER*8 LMETO(NBMET), TYPE
  186. CHARACTER*4 LFLUX(1), MOT1(1), LK0(2)
  187. CHARACTER*(40) MESERR
  188. LOGICAL LOGNC, LOGAN, LOGRES
  189. C
  190. DATA LMETO/'VLH ','SS ','AUSMPUP '/
  191. DATA LFLUX/'RESI'/
  192. DATA LK0/'CONS','VARI'/
  193. C
  194. C**** Initialisation des variables pour la gestion des erreurs.
  195. C
  196. LOGNC = .FALSE.
  197. LOGAN = .FALSE.
  198. MESERR = ' '
  199. C
  200. C******* Flux ou residu???
  201. C
  202. CALL LIRMOT(LFLUX,1,ICELL,1)
  203. IF(IERR .NE. 0)GOTO 9999
  204. IF(ICELL .NE. 1)THEN
  205. C LOGRES = .TRUE.
  206. C ELSE
  207. C
  208. C******** Message d'erreur standard
  209. C 251 2
  210. C Tentative d'utilisation d'une option non implémentée
  211. C
  212. CALL ERREUR(251)
  213. ENDIF
  214. C
  215. C**** Metode utilisée
  216. C
  217. CALL LIRMOT(LMETO,NBMET,INDMET,1)
  218. IF(IERR .NE. 0)GOTO 9999
  219. IF(INDMET .EQ. 0)THEN
  220. C
  221. C******** Message d'erreur standard
  222. C 251 2
  223. C Tentative d'utilisation d'une option non implémentée
  224. C
  225. CALL ERREUR(251)
  226. ENDIF
  227. C
  228. C**** KO constant ou variable ???
  229. C
  230. CALL LIRMOT(LK0,2,INDK0,1)
  231. IF(IERR .NE. 0)GOTO 9999
  232. IF(INDK0 .EQ. 0)THEN
  233. C
  234. C******** Message d'erreur standard
  235. C 251 2
  236. C Tentative d'utilisation d'une option non implémentée
  237. C
  238. CALL ERREUR(251)
  239. ENDIF
  240. C
  241. C**********************************
  242. C**** Lecture de l'objet MODELE ***
  243. C**********************************
  244. C
  245. ICOND = 1
  246. CALL QUETYP(TYPE,ICOND,IRET)
  247.  
  248. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  249. WRITE(IOIMP,*)' On attend un objet MMODEL'
  250. RETURN
  251. ENDIF
  252. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  253. IF(IERR.NE.0)GOTO 9999
  254. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  255. IF(IERR.NE.0)GOTO 9999
  256. C
  257. C**** Centre, FACE et FACEL
  258. C
  259. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  260. IF(IERR .NE. 0) GOTO 9999
  261. C
  262. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  263. IF(IERR .NE. 0) GOTO 9999
  264. C
  265. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  266. IF(IERR .NE. 0) GOTO 9999
  267. C
  268. C**** Lecture du CHPOINT contenant les surfaces des faces.
  269. C
  270. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  271. IF(IERR .NE. 0) GOTO 9999
  272. C
  273. C**** Lecture du CHPOINT contenant les diametres minimums.
  274. C
  275. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  276. IF(IERR .NE. 0) GOTO 9999
  277. C
  278. C**** Lecture du CHPOINT contenant les volumes
  279. C
  280. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  281. IF(IERR .NE. 0) GOTO 9999
  282. C
  283. C********** Les normales aux faces
  284. C
  285. IF(IDIM .EQ. 2)THEN
  286. C Que les normales
  287. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  288. IF(IERR .NE. 0) GOTO 9999
  289. JGN = 4
  290. JGM = 2
  291. SEGINI MLMVIT
  292. MLMVIT.MOTS(1) = 'UX '
  293. MLMVIT.MOTS(2) = 'UY '
  294. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  295. SEGSUP MLMVIT
  296. IF(IERR .NE. 0) GOTO 9999
  297. ELSE
  298. C Les normales et les tangentes
  299. TYPE = ' '
  300. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  301. IF (TYPE .NE. 'CHPOINT ') THEN
  302. CALL MATRAN(IDOMA,INORM)
  303. IF(IERR .NE. 0) GOTO 9999
  304. ENDIF
  305. JGN = 4
  306. JGM = 9
  307. SEGINI MLMVIT
  308. MLMVIT.MOTS(1) = 'UX '
  309. MLMVIT.MOTS(2) = 'UY '
  310. MLMVIT.MOTS(3) = 'UZ '
  311. MLMVIT.MOTS(4) = 'RX '
  312. MLMVIT.MOTS(5) = 'RY '
  313. MLMVIT.MOTS(6) = 'RZ '
  314. MLMVIT.MOTS(7) = 'MX '
  315. MLMVIT.MOTS(8) = 'MY '
  316. MLMVIT.MOTS(9) = 'MZ '
  317. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  318. SEGSUP MLMVIT
  319. ENDIF
  320. C
  321. C********************************
  322. C**** Fin table domaine *********
  323. C********************************
  324. C********************************
  325. C**** La table IPGAZ *******
  326. C********************************
  327. C
  328. C write(*,*) 'Son qui prima di ipgaz'
  329. C
  330. C**** Lecture de la table des proprietes du gaz
  331. C
  332. ICOND = 1
  333. CALL QUETYP(TYPE,ICOND,IRET)
  334. IF(IERR .NE. 0)GOTO 9999
  335. IF(TYPE .NE. 'TABLE ')THEN
  336. C
  337. C******* Message d'erreur standard
  338. C 37 2
  339. C On ne trouve pas d'objet de type %m1:8
  340. C
  341. MOTERR(1:8) = 'TABLE '
  342. CALL ERREUR(37)
  343. GOTO 9999
  344. ELSE
  345. ICOND = 1
  346. CALL LIROBJ(TYPE,IPGAS,ICOND,IRET)
  347. IF(IERR .NE. 0)GOTO 9999
  348. ENDIF
  349. C
  350. C**** Ordre des polynoms pour les cv_i
  351. C
  352. MTYPI = 'MOT '
  353. MTYPR = ' '
  354. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
  355. & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
  356. IF(MTYPR .NE. 'ENTIER ')THEN
  357. C
  358. C******* Message d'erreur standard
  359. C -301 0 %m1:40
  360. C
  361. MOTERR(1:40) = 'TAB1 . NORD = ??? '
  362. WRITE(IOIMP,*) MOTERR(1:40)
  363. C
  364. C******* Message d'erreur standard
  365. C 21 2
  366. C Données incompatibles
  367. C
  368. CALL ERREUR(21)
  369. GOTO 9999
  370. ENDIF
  371. NORDP1 = NORD + 1
  372. C
  373. C**** 'TMAX'
  374. C
  375. MTYPI = 'MOT '
  376. MTYPR = ' '
  377. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'TMAX',LOGII,IRETI,
  378. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  379. IF(MTYPR .NE. 'FLOTTANT')THEN
  380. C
  381. C******* Message d'erreur standard
  382. C -301 0 %m1:40
  383. C
  384. MOTERR(1:40) = 'TAB1 . TMAX = ??? '
  385. WRITE(IOIMP,*) MOTERR(1:40)
  386. C
  387. C******* Message d'erreur standard
  388. C 21 2
  389. C Données incompatibles
  390. C
  391. CALL ERREUR(21)
  392. GOTO 9999
  393. ENDIF
  394. TMAX = XVALR
  395. C
  396. C**** 'RUNIV'
  397. C
  398. MTYPI = 'MOT '
  399. MTYPR = ' '
  400. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'RUNIV',LOGII,IRETI,
  401. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  402. IF(MTYPR .NE. 'FLOTTANT')THEN
  403. C
  404. C******* Message d'erreur standard
  405. C -301 0 %m1:40
  406. C
  407. MOTERR(1:40) = 'TAB1 . RUNIV = ??? '
  408. WRITE(IOIMP,*) MOTERR(1:40)
  409. C
  410. C******* Message d'erreur standard
  411. C 21 2
  412. C Données incompatibles
  413. C
  414. CALL ERREUR(21)
  415. GOTO 9999
  416. ENDIF
  417. RUNIV = XVALR
  418. C
  419. C**** Les especes
  420. C
  421. MTYPR = ' '
  422. CALL ACMO(IPGAS,'SPECIES',MTYPR,MLMESP)
  423. IF(MTYPR .NE. 'LISTMOTS')THEN
  424. C
  425. C******* Message d'erreur standard
  426. C -301 0 %m1:40
  427. C
  428. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  429. WRITE(IOIMP,*) MOTERR(1:40)
  430. C
  431. C******* Message d'erreur standard
  432. C 21 2
  433. C Données incompatibles
  434. C
  435. CALL ERREUR(21)
  436. GOTO 9999
  437. ELSE
  438. SEGACT MLMESP
  439. NESP = MLMESP.MOTS(/2)
  440. SEGDES MLMESP
  441. ENDIF
  442. C
  443. C**** 'MASSFRA'
  444. C
  445. MTYPR = ' '
  446. CALL ACMO(IPGAS,'MASSFRA',MTYPR,MLRMFR)
  447. IF(MTYPR .NE. 'LISTREEL')THEN
  448. C
  449. C******* Message d'erreur standard
  450. C -301 0 %m1:40
  451. C
  452. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  453. WRITE(IOIMP,*) MOTERR(1:40)
  454. C
  455. C******* Message d'erreur standard
  456. C 21 2
  457. C Données incompatibles
  458. C
  459. CALL ERREUR(21)
  460. GOTO 9999
  461. ELSE
  462. SEGACT MLRMFR
  463. NESP1 = MLRMFR.PROG(/1)
  464. IF (NESP1 .NE. NESP) THEN
  465. MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
  466. WRITE(IOIMP,*) MOTERR(1:40)
  467. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  468. WRITE(IOIMP,*) MOTERR(1:40)
  469. C
  470. C******* Message d'erreur standard
  471. C 21 2
  472. C Données incompatibles
  473. C
  474. CALL ERREUR(21)
  475. GOTO 9999
  476. ENDIF
  477. SEGDES MLRMFR
  478. ENDIF
  479. C
  480. C**** 'CHEMCOEF'
  481. C
  482. MTYPR = ' '
  483. CALL ACMO(IPGAS,'CHEMCOEF',MTYPR,MLRCHE)
  484. IF(MTYPR .NE. 'LISTREEL')THEN
  485. C
  486. C******* Message d'erreur standard
  487. C -301 0 %m1:40
  488. C
  489. write(IOIMP,*) MTYPR
  490. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  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. ELSE
  500. SEGACT MLRCHE
  501. NESP1 = MLRCHE.PROG(/1)
  502. IF (NESP1 .NE. NESP) THEN
  503. MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
  504. WRITE(IOIMP,*) MOTERR(1:40)
  505. MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
  506. WRITE(IOIMP,*) MOTERR(1:40)
  507. C
  508. C******* Message d'erreur standard
  509. C 21 2
  510. C Données incompatibles
  511. C
  512. CALL ERREUR(21)
  513. GOTO 9999
  514. ENDIF
  515. SEGDES MLRCHE
  516. ENDIF
  517. C
  518. C**** On rempli les segment PROPHY
  519. C Ordre: IPGAS . 'SPECIES'
  520. C
  521. N1 = NORDP1 + 2
  522. N2 = NESP
  523. SEGINI PROPHY
  524. SEGACT MLMESP
  525. C
  526. C**** N.B. MOT1 est un CHARACTER*(4)
  527. C
  528. DO I1 = 1, NESP
  529. MOT1(1) = MLMESP.MOTS(I1)
  530. C
  531. C******* CALL ACMF(...) ne marche pas parce que on a
  532. C des blanches dans nos composantes
  533. C
  534. MTYPI = 'MOT '
  535. MTYPR = ' '
  536. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  537. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  538. C
  539. C******* En IESP a la table IPGAS.MOT1(1)
  540. C
  541. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
  542.  
  543. C
  544. C********** Message d'erreur standard
  545. C -301 0 %m1:40
  546. C
  547. MOTERR = ' '
  548. MOTERR(1:7) = 'TAB1 . '
  549. MOTERR(8:11) = MOT1(1)
  550. MOTERR(13:17) = '= ???'
  551. WRITE(IOIMP,*) MOTERR(1:40)
  552. C
  553. C********** Message d'erreur standard
  554. C 21 2
  555. C Données incompatibles
  556. C
  557. CALL ERREUR(21)
  558. GOTO 9999
  559. ENDIF
  560. C
  561. C******* W
  562. C
  563. MTYPI = 'MOT '
  564. MTYPR = ' '
  565. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'W' , LOGII,IRETI,
  566. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  567. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  568. C
  569. C********** Message d'erreur standard
  570. C -301 0 %m1:40
  571. C
  572. MOTERR = ' '
  573. MOTERR(1:7) = 'TAB1 . '
  574. MOTERR(8:11) = MOT1(1)
  575. MOTERR(13:23) = ' . W = ??? '
  576. WRITE(IOIMP,*) MOTERR(1:40)
  577. C
  578. C********** Message d'erreur standard
  579. C 21 2
  580. C Données incompatibles
  581. C
  582. CALL ERREUR(21)
  583. GOTO 9999
  584. ENDIF
  585. C PROPHY.W(I1)=XVALR
  586. PROPHY.XTAB(NORDP1+1,I1)=XVALR
  587. C
  588. C******* H0K
  589. C
  590. MTYPI = 'MOT '
  591. MTYPR = ' '
  592. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
  593. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  594. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  595.  
  596. C
  597. C********** Message d'erreur standard
  598. C -301 0 %m1:40
  599. C
  600. MOTERR = ' '
  601. MOTERR(1:7) = 'TAB1 . '
  602. MOTERR(8:11) = MOT1(1)
  603. MOTERR(13:25) = ' . H0K = ??? '
  604. WRITE(IOIMP,*) MOTERR(1:40)
  605. C
  606. C********** Message d'erreur standard
  607. C 21 2
  608. C Données incompatibles
  609. C
  610. CALL ERREUR(21)
  611. GOTO 9999
  612. ENDIF
  613. C PROPHY.H0K(I1)=XVALR
  614. PROPHY.XTAB(NORDP1+2,I1)=XVALR
  615. C
  616. C******* A
  617. C
  618. MTYPI = 'MOT '
  619. MTYPR = ' '
  620. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
  621. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  622. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
  623.  
  624. C
  625. C********** Message d'erreur standard
  626. C -301 0 %m1:40
  627. C
  628. MOTERR = ' '
  629. MOTERR(1:7) = 'TAB1 . '
  630. MOTERR(8:11) = MOT1(1)
  631. MOTERR(13:23) = ' . A = ??? '
  632. WRITE(IOIMP,*) MOTERR(1:40)
  633. C
  634. C********** Message d'erreur standard
  635. C 21 2
  636. C Données incompatibles
  637. C
  638. CALL ERREUR(21)
  639. GOTO 9999
  640. ENDIF
  641. MLREEL = IRETR
  642. SEGACT MLREEL
  643. NORD1 = MLREEL.PROG(/1)
  644. IF(NORD1 .NE. NORDP1)THEN
  645. C
  646. C********** Message d'erreur standard
  647. C -301 0 %m1:40
  648. C
  649. MOTERR = ' '
  650. MOTERR(1:10) = 'DIME(TAB1.'
  651. MOTERR(11:14) = MOT1(1)
  652. MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
  653. WRITE(IOIMP,*) MOTERR(1:40)
  654. C
  655. C********** Message d'erreur standard
  656. C 21 2
  657. C Données incompatibles
  658. C
  659. CALL ERREUR(21)
  660. GOTO 9999
  661. ENDIF
  662.  
  663. C
  664. C******* Dans le calcul, c'est plus utile ACV dans la forme
  665. C ACV(exponente,espece)
  666. C
  667. DO I2 = 1, NORDP1
  668. C PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
  669. PROPHY.XTAB(I2,I1) = MLREEL.PROG(I2)
  670. ENDDO
  671. SEGDES MLREEL
  672. ENDDO
  673. SEGDES MLMESP
  674. C
  675. C write(*,*) 'Son qui dopo ipgaz'
  676. C
  677. C**** La table IPGAZ donc a ete controllee et PROPHY est rempli
  678. C
  679. C
  680. C**** Lecture du CHPOINT ALPHA1
  681. C
  682. TYPE='CHPOINT '
  683. ICOND = 1
  684. CALL LIROBJ(TYPE,IALP1,ICOND,IRET)
  685. IF(IERR .NE. 0)GOTO 9999
  686. C
  687. C**** Control du CHPOINT: QUEPOI
  688. C
  689. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  690. C N.B. Le CHPOINT peut changer de structure pour
  691. C avoir SPG = ICEN!!!!
  692. C INDIC = 0 -> on ne fait que verifier le support geometrique
  693. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  694. C
  695. C NBCOMP > 0 -> numero des composantes
  696. C
  697. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  698. C
  699. INDIC = 1
  700. NBCOMP = 1
  701. MOT1(1) = 'SCAL'
  702. CALL QUEPOI(IALP1, MELEMC, INDIC, NBCOMP, MOT1)
  703. IF(IERR .NE. 0)THEN
  704. C
  705. C******** Message d'erreur standard
  706. C -301 0 %m1:40
  707. C
  708. MOTERR = 'IALP1 = ??? '
  709. WRITE(IOIMP,*) MOTERR(1:40)
  710. GOTO 9999
  711. ENDIF
  712. C
  713. C**** Lecture du CHPOINT ALPHA2
  714. C
  715. TYPE='CHPOINT '
  716. ICOND = 1
  717. CALL LIROBJ(TYPE,IALP2,ICOND,IRET)
  718. C
  719. C**** Control du CHPOINT: QUEPOI
  720. C
  721. INDIC = 1
  722. NBCOMP = 1
  723. MOT1(1) = 'SCAL'
  724. CALL QUEPOI(IALP2, MELEMC, INDIC, NBCOMP, MOT1)
  725. IF(IERR .NE. 0)THEN
  726. C
  727. C******** Message d'erreur standard
  728. C -301 0 %m1:40
  729. C
  730. MOTERR = 'IALP2 = ??? '
  731. WRITE(IOIMP,*) MOTERR(1:40)
  732. GOTO 9999
  733. ENDIF
  734. C
  735. C**** On va lire les pointeurs des MCHAMLs
  736. C Lecture du MCHAML 'FACEL' alpha
  737. C
  738. TYPE='MCHAML '
  739. CALL LIROBJ(TYPE,IALF1,1,IRET)
  740. IF(IERR.NE.0) GOTO 9999
  741. CALL LIROBJ(TYPE,IALF2,1,IRET)
  742. IF(IERR.NE.0) GOTO 9999
  743. C Lecture du MCHAML 'FACEL' densité
  744. C
  745. TYPE='MCHAML '
  746. CALL LIROBJ(TYPE,IROF1,1,IRET)
  747. IF(IERR.NE.0) GOTO 9999
  748. CALL LIROBJ(TYPE,IROF2,1,IRET)
  749. IF(IERR.NE.0) GOTO 9999
  750. C
  751. C**** Lecture du MCHAML 'FACEL' vitesse
  752. C
  753. TYPE='MCHAML '
  754. CALL LIROBJ(TYPE,IVITF1,1,IRET)
  755. IF(IERR .NE. 0) GOTO 9999
  756. CALL LIROBJ(TYPE,IVITF2,1,IRET)
  757. IF(IERR .NE. 0) GOTO 9999
  758. C
  759. C**** Lecture du MCHAML 'FACEL' contenant la pression
  760. C
  761. TYPE='MCHAML '
  762. CALL LIROBJ(TYPE,IPF1,1,IRET)
  763. IF(IERR .NE. 0) GOTO 9999
  764. CALL LIROBJ(TYPE,IPF2,1,IRET)
  765. IF(IERR .NE. 0) GOTO 9999
  766. C
  767. C**** Lecture du CHAMPOINT contenant grad(alpha)/|grad(alpha)|
  768. C
  769. TYPE='CHPOINT '
  770. ICOND = 1
  771. CALL LIROBJ(TYPE,IGRALP,ICOND,IRET)
  772. IF(IERR .NE. 0)GOTO 9999
  773. C
  774. C**** Control du CHPOINT
  775. C
  776. JGN = 4
  777. JGM = IDIM
  778. SEGINI MLMOTS
  779. MLMOTS.MOTS(1) = 'P1DX'
  780. MLMOTS.MOTS(2) = 'P1DY'
  781. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'P1DZ'
  782. C
  783. C**** On controlle l'ordre de composantes de IAGN1
  784. C
  785. CALL QUEPO1(IGRALP, MELEMF, MLMOTS)
  786. IF(IERR .NE. 0)THEN
  787. C
  788. C******** Message d'erreur standard
  789. C -301 0 %m1:40
  790. C
  791. MOTERR = 'GRAALP = ??? '
  792. WRITE(IOIMP,*) MOTERR(1:40)
  793.  
  794. GOTO 9999
  795. ENDIF
  796. SEGSUP MLMOTS
  797. C
  798. C**** NINC = nombre d'inconnues
  799. C
  800. NINC=(IDIM+3)*2
  801. C
  802. TYPE='LISTMOTS'
  803. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  804. IF(IERR .NE. 0) GOTO 9999
  805. MLMOTS = ILIINC
  806. SEGACT MLMOTS
  807. NC = MLMOTS.MOTS(/2)
  808. SEGDES MLMOTS
  809. IF(NC .NE. NINC)THEN
  810. MOTERR(1:40) = 'LISTINCO = ???'
  811. WRITE(IOIMP,*) MOTERR
  812. C
  813. C******* Message d'erreur standard
  814. C 21 2
  815. C Données incompatibles
  816. C
  817. CALL ERREUR(21)
  818. GOTO 9999
  819. ENDIF
  820. C
  821. C**** Lecture du CHAMPOINT ou du REEL contenant K0
  822. C
  823. IF (INDK0 .EQ. 1) THEN
  824. ICOND = 1
  825. CALL LIRREE(K0, ICOND, IRET)
  826. IF(IERR .NE. 0)GOTO 9999
  827. ELSE
  828. TYPE='CHPOINT '
  829. ICOND = 1
  830. CALL LIROBJ(TYPE,ICHPK0,ICOND,IRET)
  831. IF(IERR .NE. 0)GOTO 9999
  832. INDIC = 1
  833. NBCOMP = 1
  834. MOT1(1) = 'SCAL'
  835. CALL QUEPOI(ICHPK0, MELEMC, INDIC, NBCOMP, MOT1)
  836. IF(IERR .NE. 0) GOTO 9999
  837. ENDIF
  838. C
  839. C**** Lecture de EPS
  840. C
  841. ICOND = 1
  842. CALL LIRREE(EPS, ICOND, IRET)
  843. IF(IERR .NE. 0)GOTO 9999
  844. C
  845. C**** Boundary condition
  846. C
  847. IRET=0
  848. TYPE='MAILLAGE'
  849. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  850. IF(IERR.NE.0)GOTO 9999
  851. IF(IRET .EQ. 0)THEN
  852. MELLIM = 0
  853. ELSE
  854. MELEME=IFLIM
  855. SEGACT MELEME
  856. ITOTO=MELEME.NUM(/2)
  857. IF(ITOTO .EQ. 0)THEN
  858. MELLIM = 0
  859. ELSE
  860. MELLIM = IFLIM
  861. ENDIF
  862. SEGDES MELEME
  863. ENDIF
  864. C
  865. C**** Bas Mach (AUSMPUP)
  866. C
  867. IF(INDMET .EQ. 3) THEN
  868. TYPE = 'CHPOINT '
  869. C
  870. C******* Reference speed
  871. C
  872. CALL LIROBJ(TYPE,IUINF1,1,IRET)
  873. IF(IERR .NE. 0) GOTO 9999
  874. INDIC = 1
  875. NBCOMP = 1
  876. MOT1(1) = 'SCAL'
  877. CALL QUEPOI(IUINF1, MELEMC, INDIC, NBCOMP, MOT1)
  878. IF(IERR .NE. 0) GOTO 9999
  879. C
  880. C******* Minimal cutoff
  881. C
  882. TYPE = 'CHPOINT '
  883. CALL LIROBJ(TYPE,IUINF2,1,IRET)
  884. IF(IERR .NE. 0) GOTO 9999
  885. INDIC = 1
  886. NBCOMP = 1
  887. MOT1(1) = 'SCAL'
  888. CALL QUEPOI(IUINF2, MELEMC, INDIC, NBCOMP, MOT1)
  889. IF(IERR .NE. 0) GOTO 9999
  890. C
  891. ELSE
  892. IUINF1=0
  893. IUINF2=0
  894. ENDIF
  895. C
  896. C write(*,*) 'Son qui dopo la lettura degli inputs'
  897. C
  898. C**** Creation du residu
  899. C
  900. TYPE = 'CHPOINT '
  901. CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
  902. C
  903. C**** Calcul des flux et du pas du temps.
  904. C
  905. CALL KODFL1(INDK0,NESP,NORD,TMAX,RUNIV,PROPHY,
  906. & MLRCHE,MLRMFR,
  907. & INDMET,
  908. & IALP1, IALP2,
  909. & IALF1,IROF1,IVITF1,IPF1,
  910. & IALF2,IROF2,IVITF2,IPF2,
  911. & IUINF1, IUINF2,
  912. & K0,ICHPK0,
  913. & IGRALP,EPS,
  914. & ICHPSU,ICHPDI,ICHPVO,
  915. & MELEMC,MELEMF,MELEFE,MELLIM,
  916. & ICHRES,
  917. & DT,SURFL,
  918. & LOGNC,LOGAN,MESERR)
  919. C
  920. IF(LOGAN)THEN
  921. C
  922. C******* Anomalie detectée
  923. C
  924. C
  925. C******* Message d'erreur standard
  926. C -301 0
  927. C %m1:40
  928. C
  929. MOTERR(1:40) = MESERR(1:40)
  930. WRITE(IOIMP,*) MOTERR(1:40)
  931. C
  932. C******* Message d'erreur standard
  933. C 5 3
  934. C Erreur anormale.contactez votre support
  935. C
  936. CALL ERREUR(5)
  937. GOTO 9999
  938. ENDIF
  939. IF(LOGNC)THEN
  940. C
  941. C******* Message d'erreur standard
  942. C -301 0
  943. C %m1:40
  944. C
  945. MOTERR(1:40) = MESERR(1:40)
  946. WRITE(IOIMP,*) MOTERR(1:40)
  947. C
  948. C******* Message d'erreur standard
  949. C 460 2
  950. C Pas de convergence dans les itérations internes
  951. C
  952. CALL ERREUR(460)
  953. GOTO 9999
  954. ENDIF
  955. C
  956. C**** Ecriture des resultats
  957. C
  958. CALL ECRREE(SURFL)
  959. CALL ECRREE(DT)
  960. TYPE = 'CHPOINT '
  961. IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
  962. C
  963. SEGSUP PROPHY
  964. C
  965. 9999 CONTINUE
  966. RETURN
  967. END
  968.  
  969.  
  970.  
  971.  
  972.  
  973.  
  974.  
  975.  
  976.  
  977.  
  978.  
  979.  
  980.  
  981.  
  982.  
  983.  
  984.  
  985.  

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