Télécharger kon19.eso

Retour à la liste

Numérotation des lignes :

  1. C KON19 SOURCE CB215821 20/11/25 13:31:57 10792
  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.  
  629.  

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