Télécharger kon19.eso

Retour à la liste

Numérotation des lignes :

  1. C KON19 SOURCE KK2000 14/04/10 21:15:16 8032
  2. SUBROUTINE KON19
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : KON19
  8. C
  9. C DESCRIPTION : Subroutine appellée par KON2
  10. C
  11. C Modelisation 2D/3D des equations d'Euler
  12. C MULTIESPECES!!!!!!!!!!!!!!!
  13. C
  14. C Calcul du jacobien
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : S. KUDRIAKOV, DRN/DMT/SEMT/LTMF
  19. C
  20. C*********************************************************************
  21. C
  22. C APPELES (Calcul) : KONMSP (calcul du jacobien, gaz "calorically
  23. C perfect",multiespeces, 2D, AUSM+)
  24. C : KONMS3 (calcul du jacobien, gaz "calorically
  25. C perfect",multiespeces, 3D, AUSM+)
  26. C*********************************************************************
  27. C
  28. C*** SYNTAXE
  29. C
  30. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  31. C un gaz parfait mono-constituent polytropique
  32. C Inconnues: densité, quantité de mouvement, énergie totale par
  33. C unité de volumes (variables conservatives)
  34. C
  35. C RMAT1 = 'KONV' 'VF' 'PERFMULT' 'JACOCONV' MOT3 TABD TABP LMOT1
  36. C (MAILIM) CHPO1 CHPO2 CHPO3 CHPO4 ;
  37. C-----------------------
  38. C ENTREES
  39. C-----------------------
  40. C MOT3 : objet de type MOT
  41. C 'AUSMPLUS' : jacobien du residu pour la methode AUSM+
  42. C
  43. C TABD : la table domaine
  44. C
  45. C TABP : TABLE qui contient :
  46. C * les noms des especes qui apparessent
  47. C explicitement dans les equations d'Euler en
  48. C TABP . 'ESPEULE' (list de mots);
  49. C * le nom de l'espece qui n'y est pas (mots);
  50. C * les CP et les CV du gas en
  51. C TABP . 'CP' (table)
  52. C TABP . 'CV' (table)
  53. C
  54. C LMOT1 : objet de type LISTMOTS
  55. C Noms de composantes des variable primales et duales de RMAT1.
  56. C Il contient dans l'ordre suivant: le noms de la densité,
  57. C du momentum, de l'énergie totale et les fraction massiques
  58. C par unité de volume
  59. C
  60. C MAILIM : MAIILAGE de POI1 ou on ne veut pas calculer le FLUX
  61. C convective
  62. C
  63. C CHPO1 : CHPOINT contenant la masse volumique
  64. C (SPG = TAB1 . 'CENTRE', une seule composante,
  65. C 'SCAL').
  66. C
  67. C CHPO2 : CHPOINT contenant la vitesse
  68. C (SPG = TAB1 . 'CENTRE', deux/trois composantes
  69. C 'UX', 'UY', 'UZ')
  70. C
  71. C CHPO3 : CHPOINT contenant la pression du gaz
  72. C (SPG = TAB1 . 'CENTRE', une seule composante,
  73. C 'SCAL').
  74. C
  75. C CHPO4 : CHPOINT contenant les fraction massiques
  76. C des differentes especes
  77. C (SPG = TAB1 . 'CENTRE', nombre des composantes = NESP-1).
  78. C
  79. C---------------------
  80. C SORTIES
  81. C---------------------
  82. C RMAT1 : objet de type MATRIK
  83. C (SPG = TAB1 . 'CENTRE')
  84. C (inconnues primales = inconnues duales = LMOT1)
  85. C
  86. C************************************************************************
  87. C
  88. C HISTORIQUE (Anomalies et modifications éventuelles)
  89. C
  90. C HISTORIQUE :
  91. C
  92. C************************************************************************
  93. C
  94. IMPLICIT INTEGER(I-N)
  95. IMPLICIT REAL*8(A-H,O-Z)
  96.  
  97.  
  98. -INC PPARAM
  99. -INC CCOPTIO
  100. -INC SMLMOTS
  101. -INC SMCHPOI
  102. -INC SMELEME
  103.  
  104. POINTEUR MLMVIT.MLMOTS
  105. C
  106. INTEGER NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM
  107. & ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI
  108. & ,ICHPVO, INORM, ICP, MMODEL
  109. & ,IJACO, ILIINC, NC, IFLIM, MELLIM, ICACCA
  110. & ,IIMPL, IRN, IVN, IPN, IYN, IUINF, IUPRI
  111. & ,I1, JG, ICOND, IRETOU, ICV, INEFMD, IPGAS
  112. C
  113. PARAMETER (NBJAC=2)
  114. CHARACTER*8 TYPE, LJACO(NBJAC), MTYPR
  115. CHARACTER*4 MOT
  116. CHARACTER*(4) MOT1(3), CELLCH
  117. CHARACTER*(40) MESERR
  118. REAL*8 CP, CV
  119. C----------------------------------------------------
  120. C************ Variables en ACCTAB ******************
  121. C----------------------------------------------------
  122. INTEGER IVALI, IRETI,IVALR, IRETR
  123. REAL*8 XVALI,XVALR
  124. LOGICAL LOGII, LOGIR
  125. CHARACTER*(8) CHARR,MTYPI
  126. DATA LJACO/'AUSMPLUS','AUSMPLM '/
  127. cC----------------------------------------------------
  128. cC************ Variables en ACCTAB ******************
  129. cC----------------------------------------------------
  130. c INTEGER IVALI, IRETI,IVALR, IRETR
  131. c REAL*8 XVALI,XVALR
  132. c LOGICAL LOGII, LOGIR
  133. c CHARACTER*(8) CHARR,MTYPI
  134. C----------------------------------------------------
  135. -INC SMLREEL
  136. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  137. C-----------------------------------------
  138. C Initialisation des variables en ACCTAB
  139. C-----------------------------------------
  140. IVALI = 0
  141. IVALR = 0
  142. XVALI = 0.0D0
  143. XVALR = 0.0D0
  144. LOGII = .FALSE.
  145. LOGIR = .FALSE.
  146. IRETI = 0
  147. IRETR = 0
  148. CHARR = ' '
  149. C-----------------------------
  150. C**** Type of Jacobian
  151. C-----------------------------
  152. CALL LIRMOT(LJACO,NBJAC,IIMPL,1)
  153. IF(IERR .NE. 0)GOTO 9999
  154. C*******************************
  155. C**** La table domaine *********
  156. C*******************************
  157. ICOND = 1
  158. CALL QUETYP(TYPE,ICOND,IRET)
  159. C
  160. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  161. WRITE(IOIMP,*)' On attend un objet MMODEL'
  162. GOTO 9999
  163. ENDIF
  164. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  165. IF(IERR.NE.0)GOTO 9999
  166. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  167. C INEFMD inutilisé
  168. IF(IERR.NE.0)GOTO 9999
  169. C--------------------------------
  170. C**** Centre, FACE, FACEL, ELTFA
  171. C--------------------------------
  172. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  173. IF(IERR .NE. 0) GOTO 9999
  174. C
  175. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  176. IF(IERR .NE. 0) GOTO 9999
  177. C
  178. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  179. IF(IERR .NE. 0) GOTO 9999
  180. C
  181. CALL LEKTAB(IDOMA,'ELTFA',MELTFA)
  182. IF(IERR .NE. 0) GOTO 9999
  183. C---------------------------------------------------------
  184. C**** Lecture du CHPOINT contenant les surfaces des faces.
  185. C---------------------------------------------------------
  186. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  187. IF(IERR .NE. 0) GOTO 9999
  188. INDIC = 1
  189. NBCOMP = 1
  190. MOT = 'SCAL'
  191. CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  192. IF(IERR .NE. 0) GOTO 9999
  193. C---------------------------------------------------------
  194. C**** Lecture du CHPOINT contenant les diametres minimums.
  195. C---------------------------------------------------------
  196. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  197. IF(IERR .NE. 0) GOTO 9999
  198. INDIC = 1
  199. NBCOMP = 1
  200. MOT = 'SCAL'
  201. CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT)
  202. IF(IERR .NE. 0) GOTO 9999
  203. C----------------------------------------------
  204. C**** Lecture du CHPOINT contenant les volumes
  205. C----------------------------------------------
  206. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  207. IF(IERR .NE. 0) GOTO 9999
  208. INDIC = 1
  209. NBCOMP = 1
  210. MOT = 'SCAL'
  211. CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  212. IF(IERR .NE. 0) GOTO 9999
  213. C----------------------------
  214. C**** Les normales aux faces
  215. C----------------------------
  216. IF(IDIM .EQ. 2)THEN
  217. C Que les normales
  218. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  219. IF(IERR .NE. 0) GOTO 9999
  220. JGN = 4
  221. JGM = 2
  222. SEGINI MLMVIT
  223. MLMVIT.MOTS(1) = 'UX '
  224. MLMVIT.MOTS(2) = 'UY '
  225. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  226. SEGSUP MLMVIT
  227. IF(IERR .NE. 0) GOTO 9999
  228. ELSE
  229. C Les normales et les tangentes
  230. TYPE = ' '
  231. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  232. IF (TYPE .NE. 'CHPOINT ') THEN
  233. CALL MATRAN(IDOMA,INORM)
  234. IF(IERR .NE. 0) GOTO 9999
  235. ENDIF
  236. JGN = 4
  237. JGM = 9
  238. SEGINI MLMVIT
  239. MLMVIT.MOTS(1) = 'UX '
  240. MLMVIT.MOTS(2) = 'UY '
  241. MLMVIT.MOTS(3) = 'UZ '
  242. MLMVIT.MOTS(4) = 'RX '
  243. MLMVIT.MOTS(5) = 'RY '
  244. MLMVIT.MOTS(6) = 'RZ '
  245. MLMVIT.MOTS(7) = 'MX '
  246. MLMVIT.MOTS(8) = 'MY '
  247. MLMVIT.MOTS(9) = 'MZ '
  248. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  249. SEGSUP MLMVIT
  250. ENDIF
  251. C********************************
  252. C**** Fin table domaine *********
  253. C********************************
  254. ICOND = 1
  255. CALL QUETYP(MTYPR,ICOND,IRETOU)
  256. IF(IERR .NE. 0)GOTO 9999
  257. IF(MTYPR .NE. 'TABLE ')THEN
  258. C---------------------------------------
  259. C Message d'erreur standard
  260. C 37 2
  261. C On ne trouve pas d'objet de type %m1:8
  262. C---------------------------------------
  263. MOTERR(1:8) = 'TABLE '
  264. CALL ERREUR(37)
  265. GOTO 9999
  266. ELSE
  267. ICOND = 1
  268. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  269. IF(IERR .NE. 0)GOTO 9999
  270. ENDIF
  271. C-------------------------------------------
  272. C******** Reading the CPs *****************
  273. C-------------------------------------------
  274. MTYPR = ' '
  275. CALL ACMO(IPGAS,'CP',MTYPR,ICP)
  276. IF(MTYPR .NE. 'TABLE ')THEN
  277. C--------------------------------
  278. C Message d'erreur standard
  279. C -301 0 %m1:40
  280. C--------------------------------
  281. MOTERR(1:40) = 'TAB1 . CP = ??? '
  282. WRITE(IOIMP,*) MOTERR(1:40)
  283. C---------------------------------
  284. C Message d'erreur standard
  285. C 21 2
  286. C Données incompatibles
  287. C--------------------------------
  288. CALL ERREUR(21)
  289. GOTO 9999
  290. ENDIF
  291. C-------------------------------------------
  292. C******** Reading the CVs *****************
  293. C-------------------------------------------
  294. MTYPR = ' '
  295. CALL ACMO(IPGAS,'CV',MTYPR,ICV)
  296. IF(MTYPR .NE. 'TABLE ')THEN
  297. C--------------------------------
  298. C Message d'erreur standard
  299. C -301 0 %m1:40
  300. C--------------------------------
  301. MOTERR(1:40) = 'TAB1 . CV = ??? '
  302. WRITE(IOIMP,*) MOTERR(1:40)
  303. C---------------------------------
  304. C Message d'erreur standard
  305. C 21 2
  306. C Données incompatibles
  307. C--------------------------------
  308. CALL ERREUR(21)
  309. GOTO 9999
  310. ENDIF
  311. C---------------------------------------------------------
  312. C Reading Les especes qui sont dans les Equations d'Euler
  313. C---------------------------------------------------------
  314. MTYPR = ' '
  315. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  316. IF(MTYPR .NE. 'LISTMOTS')THEN
  317. C---------------------------
  318. C Message d'erreur standard
  319. C -301 0 %m1:40
  320. C---------------------------
  321. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  322. WRITE(IOIMP,*) MOTERR(1:40)
  323. C---------------------------
  324. C Message d'erreur standard
  325. C 21 2
  326. C Données incompatibles
  327. C--------------------------
  328. CALL ERREUR(21)
  329. GOTO 9999
  330. ENDIF
  331. C-----------------------------------------------------------------
  332. C Reading Nom de l'espece qui n'est pas dans les equations d'Euler
  333. C-----------------------------------------------------------------
  334. MTYPI = 'MOT '
  335. MTYPR = ' '
  336. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
  337. & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR)
  338. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN
  339. C-------------------------------
  340. C Message d'erreur standard
  341. C -301 0 %m1:40
  342. C-------------------------------
  343. MOTERR = 'TAB1 . ESPNEULE = ??? '
  344. WRITE(IOIMP,*) MOTERR(1:40)
  345. C------------------------------
  346. C Message d'erreur standard
  347. C 21 2
  348. C Données incompatibles
  349. C------------------------------
  350. CALL ERREUR(21)
  351. GOTO 9999
  352. ENDIF
  353. C--------------------------------------------------------------
  354. C Creating the lists of real numbers of CP and CV
  355. C--------------------------------------------------------------
  356. SEGACT MLMOT1
  357. NESP = MLMOT1.MOTS(/2)
  358. C----------------------
  359. C** List de CP et CV **
  360. C----------------------
  361. JG = NESP+1
  362. SEGINI MLRECP
  363. SEGINI MLRECV
  364. DO I1 = 1, NESP
  365. C-------------------------------
  366. C N.B. MOT1 est un CHARACTER*(4)
  367. C-------------------------------
  368. MOT1(1) = MLMOT1.MOTS(I1)
  369. MTYPI = 'MOT '
  370. MTYPR = ' '
  371. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  372. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  373. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  374. C------------------------------
  375. C Message d'erreur standard
  376. C -301 0 %m1:40
  377. C------------------------------
  378. MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? '
  379. WRITE(IOIMP,*) MOTERR(1:40)
  380. C------------------------------
  381. C Message d'erreur standard
  382. C 21 2
  383. C Données incompatibles
  384. C------------------------------
  385. CALL ERREUR(21)
  386. GOTO 9999
  387. ENDIF
  388. MLRECP.PROG(I1) = CP
  389. C-------------------------------------------
  390. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  391. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  392. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  393. C---------------------------
  394. C Message d'erreur standard
  395. C -301 0 %m1:40
  396. C---------------------------
  397. MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? '
  398. WRITE(IOIMP,*) MOTERR(1:40)
  399. C---------------------------
  400. C Message d'erreur standard
  401. C 21 2
  402. C Données incompatibles
  403. C---------------------------
  404. CALL ERREUR(21)
  405. GOTO 9999
  406. ENDIF
  407. MLRECV.PROG(I1) = CV
  408. ENDDO
  409. MTYPI = 'MOT '
  410. MTYPR = ' '
  411. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  412. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  413. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  414. C---------------------------
  415. C Message d'erreur standard
  416. C -301 0 %m1:40
  417. C---------------------------
  418. MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? '
  419. WRITE(IOIMP,*) MOTERR(1:40)
  420. C---------------------------
  421. C Message d'erreur standard
  422. C 21 2
  423. C Données incompatibles
  424. C---------------------------
  425. CALL ERREUR(21)
  426. GOTO 9999
  427. ENDIF
  428. MLRECP.PROG(JG) = CP
  429. C
  430. MTYPI = 'MOT '
  431. MTYPR = ' '
  432. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  433. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  434. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  435. C----------------------------
  436. C Message d'erreur standard
  437. C -301 0 %m1:40
  438. C----------------------------
  439. MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? '
  440. WRITE(IOIMP,*) MOTERR(1:40)
  441. C----------------------------
  442. C Message d'erreur standard
  443. C 21 2
  444. C Données incompatibles
  445. C----------------------------
  446. CALL ERREUR(21)
  447. GOTO 9999
  448. ENDIF
  449. MLRECV.PROG(JG) = CV
  450. C********************************************
  451. C**** Fin de la table de gas ****************
  452. C********************************************
  453. C--------------------------
  454. C**** La list des inconnues
  455. C--------------------------
  456. TYPE='LISTMOTS'
  457. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  458. IF(IERR .NE. 0) GOTO 9999
  459. MLMOTS = ILIINC
  460. SEGACT MLMOTS
  461. NC = MLMOTS.MOTS(/2)
  462. SEGDES MLMOTS
  463. IF(NC .NE. (IDIM+2+NESP))THEN
  464. MOTERR(1:40) = 'LISTINCO = ???'
  465. WRITE(IOIMP,*) MOTERR
  466. C--------------------------
  467. C Message d'erreur standard
  468. C 21 2
  469. C Données incompatibles
  470. C--------------------------
  471. CALL ERREUR(21)
  472. GOTO 9999
  473. ENDIF
  474. C-------------------------------------
  475. C******** Boundary condition *********
  476. C-------------------------------------
  477. IRET=0
  478. TYPE='MAILLAGE'
  479. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  480. IF(IERR.NE.0)GOTO 9999
  481. IF(IRET .EQ. 0)THEN
  482. MELLIM = 0
  483. ELSE
  484. MELEME=IFLIM
  485. SEGACT MELEME
  486. ICACCA=MELEME.NUM(/2)
  487. IF(ICACCA .EQ. 0)THEN
  488. MELLIM = 0
  489. ELSE
  490. MELLIM = IFLIM
  491. ENDIF
  492. SEGDES MELEME
  493. ENDIF
  494. C--------------------------
  495. C**** La densité au centre
  496. C--------------------------
  497. TYPE = 'CHPOINT '
  498. CALL LIROBJ(TYPE,IRN,1,IRET)
  499. IF(IERR .NE. 0) GOTO 9999
  500. INDIC = 1
  501. NBCOMP = 1
  502. MOT = 'SCAL'
  503. CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  504. IF(IERR .NE. 0) GOTO 9999
  505. C---------------------------
  506. C*** La vitesse au centre
  507. C---------------------------
  508. TYPE = 'CHPOINT '
  509. CALL LIROBJ(TYPE,IVN,1,IRET)
  510. IF(IERR .NE. 0) GOTO 9999
  511. JGN = 4
  512. JGM = IDIM
  513. SEGINI MLMVIT
  514. MLMVIT.MOTS(1) = 'UX '
  515. MLMVIT.MOTS(2) = 'UY '
  516. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  517. CALL QUEPO1(IVN, MELEMC, MLMVIT)
  518. SEGSUP MLMVIT
  519. IF(IERR .NE. 0) GOTO 9999
  520. C----------------------------
  521. C*** La pression au centre
  522. C----------------------------
  523. TYPE = 'CHPOINT '
  524. CALL LIROBJ(TYPE,IPN,1,IRET)
  525. IF(IERR .NE. 0) GOTO 9999
  526. INDIC = 1
  527. NBCOMP = 1
  528. MOT = 'SCAL'
  529. CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
  530. IF(IERR .NE. 0) GOTO 9999
  531. C-----------------------------
  532. C*** Fraction massiques
  533. C*** des especes "splittees"
  534. C-----------------------------
  535. TYPE = 'CHPOINT '
  536. CALL LIROBJ(TYPE,IYN,1,IRET)
  537. IF(IERR .NE. 0) GOTO 9999
  538. CALL QUEPO1(IYN, MELEMC, MLMOT1)
  539. IF(IERR .NE. 0) THEN
  540.  
  541. MOTERR = 'CHPO FR.MAS. = ?????'
  542. WRITE(IOIMP,*) MOTERR(1:40)
  543. CALL ERREUR(21)
  544. GOTO 9999
  545. ENDIF
  546. C-----------------------------------
  547. C**** Bas Mach
  548. C-----------------------------------
  549. IF(IIMPL .EQ. 2)THEN
  550. TYPE = 'CHPOINT '
  551. C------------------
  552. C******* Cut off 1
  553. C------------------
  554. CALL LIROBJ(TYPE,IUINF,1,IRET)
  555. IF(IERR .NE. 0) GOTO 9999
  556. INDIC = 1
  557. NBCOMP = 1
  558. MOT = 'SCAL'
  559. CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT)
  560. IF(IERR .NE. 0) GOTO 9999
  561. C-----------------
  562. C******* Cut off 2
  563. C-----------------
  564. TYPE = 'CHPOINT '
  565. CALL LIROBJ(TYPE,IUPRI,1,IRET)
  566. IF(IERR .NE. 0) GOTO 9999
  567. INDIC = 1
  568. NBCOMP = 1
  569. MOT = 'SCAL'
  570. CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
  571. IF(IERR .NE. 0) GOTO 9999
  572. C
  573. ELSE
  574. IUINF=0
  575. IUPRI=0
  576. ENDIF
  577. C***************************************
  578. C***** Fin reading chpoints *********
  579. C***************************************
  580. NESP=NESP+1
  581. IF(IIMPL .EQ. 1)THEN
  582. c------------------------------
  583. c AUSM+
  584. c-----------------------------
  585. IF(IDIM .EQ. 2) THEN
  586. CALL KONMSP(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP,
  587. & MLRECV,INORM,ICHPVO,ICHPSU,MELEMC,MELEFE,MELLIM,IJACO)
  588. ELSE
  589. CALL KONMS3(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP,
  590. & MLRECV,INORM,ICHPVO,ICHPSU,MELEMC,MELEFE,MELLIM,IJACO)
  591. ENDIF
  592. C------------------------------------------------------------
  593. ELSEIF(IIMPL .EQ. 2)THEN
  594. C-----------------------------
  595. C********** AUSM+ low Mach
  596. C-----------------------------
  597. IF(IDIM .EQ. 2)THEN
  598. CALL KBMMS2(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP,MLRECV,
  599. $ INORM,ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE,
  600. $ MELLIM,IJACO)
  601. ENDIF
  602. ENDIF
  603. TYPE='MATRIK '
  604. CALL ECROBJ(TYPE,IJACO)
  605. 9999 CONTINUE
  606. RETURN
  607. END
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  

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