Télécharger clim22.eso

Retour à la liste

Numérotation des lignes :

  1. C CLIM22 SOURCE CB215821 19/08/01 21:15:19 10279
  2. SUBROUTINE CLIM22(IJAC)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : CLIM22
  8. C
  9. C DESCRIPTION : Subroutine appellée par CLIM2
  10. C
  11. C Modelisation 2D/3D des equations d'Euler
  12. C Conditions aux limites
  13. C
  14. C Calcul du flux/residu/jacobian de flux
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF
  19. C
  20. C************************************************************************
  21. C
  22. C
  23. C SORTIES
  24. C
  25. C RCHPLI : on donne densité, vitesse, pression
  26. C et les fractions massiques sur le bord
  27. C (SPG = $TAB2 . 'CENTRE', composantes en LMOTP)
  28. C
  29. C RCHPRE : residu (SPG = $TAB1 . 'CENTRE', composantes en LMOTC)
  30. C
  31. C************************************************************************
  32. C
  33. C HISTORIQUE (Anomalies et modifications éventuelles)
  34. C
  35. C HISTORIQUE : 3/12/03 - for the 'INRI' and 'OUTP' there was
  36. C implemented option for k-\eps model
  37. C (k and \eps are treated as a passive scalars)
  38. C
  39. C 20/12/04 - generalisation de 'OUTP' for the
  40. C CREBCOM model (k, \eps and K0 are treated
  41. C as a passive scalars)
  42. C
  43. C 03/02/06 - implementation of boundary conditions of
  44. C 'RESE'rvoir in the explicit case without
  45. C passive scalars.
  46. C************************************************************************
  47. IMPLICIT INTEGER(I-N)
  48. IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. -INC CCOPTIO
  51. -INC SMLMOTS
  52. -INC SMELEME
  53. -INC SMLENTI
  54. POINTEUR MLMVIT.MLMOTS
  55. C
  56. INTEGER IJAC, IJACO, I, NESP,NSP
  57. & ,IDOMA, IDBOR, IRET, MELEMC, MELEFE, MELEMF, ICHPVO, INORM
  58. & ,ICHPSU, MELECB, NBCOMP, INDIC, MELEFC, MELRES
  59. & ,JGN, JGM, NBELEM, NBNN, NBSOUS, NBREF, NGF, NLC
  60. & ,I1, ICEN, N1, ILIINP
  61. & ,ILIINC, IROC, IVITC, IPC, ICHLIM, NBOPT, ILIM
  62. & ,ICHRES, ICHRLI, IYN, IKAN, IEPSN, IK0N
  63. & ,NKID,NKMT,NMATRI,NRIGE,MMODEL,INEFMD
  64. & ,JG, ICOND, IRETOU, ICP, ICV, IPGAS,IKEPS,ICREB
  65. PARAMETER (NBOPT=9)
  66. CHARACTER*8 LOPT(NBOPT)
  67. CHARACTER*4 MOT
  68. CHARACTER*(4) MOT1(3), CELLCH
  69. CHARACTER*8 TYPE
  70. REAL*8 CP, CV
  71. C----------------------------------------------------
  72. C************ Variables en ACCTAB ******************
  73. C----------------------------------------------------
  74. INTEGER IVALI, IRETI, IVALR, IRETR
  75. REAL*8 XVALI,XVALR
  76. LOGICAL LOGII, LOGIR
  77. CHARACTER*(8) CHARR,MTYPI, MTYPR
  78. C-----------------------------------------------------
  79. DATA LOPT/'INRI ','OUTRI ','INJE ','OUTP ',
  80. & 'INSU ','INOU ','INSS ','OUTSS ',
  81. & 'RESE '/
  82. C---------------------------------------------------
  83. -INC SMLREEL
  84. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  85. C-----------------------------------------
  86. C Initialisation des variables en ACCTAB
  87. C-----------------------------------------
  88. IVALI = 0
  89. IVALR = 0
  90. XVALI = 0.0D0
  91. XVALR = 0.0D0
  92. LOGII = .FALSE.
  93. LOGIR = .FALSE.
  94. IRETI = 0
  95. IRETR = 0
  96. CHARR = ' '
  97. C-------------------------------------------
  98. C If IKEPS = 0 then there is now passive
  99. C scalars, otherwise IKEPS = 1
  100. C ...same about ICREB
  101. C-------------------------------------------
  102. IKEPS = 0
  103. ICREB = 0
  104. C*******************************
  105. C**** La table domaine *********
  106. C*******************************
  107. C
  108. CALL LIROBJ('MMODEL ',MMODEL,1,IRET)
  109. CALL ACTOBJ('MMODEL ',MMODEL,1)
  110. IF(IERR.NE.0)GOTO 9999
  111. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  112. C INEFMD inutilisé
  113. IF(IERR .NE. 0)GOTO 9999
  114. C-----------------------------------------
  115. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  116. IF(IERR .NE. 0) GOTO 9999
  117. C-----------------------------------------
  118. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  119. IF(IERR .NE. 0) GOTO 9999
  120. C---------------------------------------------
  121. C**** Lecture du CHPOINT contenant les volumes
  122. C---------------------------------------------
  123. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  124. IF(IERR .NE. 0) GOTO 9999
  125. INDIC = 1
  126. NBCOMP = 1
  127. MOT = 'SCAL'
  128. CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  129. IF(IERR .NE. 0) GOTO 9999
  130. C---------------------------------------------
  131. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  132. IF(IERR .NE. 0) GOTO 9999
  133. INDIC = 1
  134. NBCOMP = 1
  135. MOT = 'SCAL'
  136. CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  137. IF(IERR .NE. 0) GOTO 9999
  138. C--------------------------------------------
  139. C**** Les normales aux faces
  140. C--------------------------------------------
  141. IF(IDIM .EQ. 2)THEN
  142. C Que les normales
  143. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  144. IF(IERR .NE. 0) GOTO 9999
  145. JGN = 4
  146. JGM = 2
  147. SEGINI MLMVIT
  148. MLMVIT.MOTS(1) = 'UX '
  149. MLMVIT.MOTS(2) = 'UY '
  150. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  151. SEGDES MLMVIT
  152. IF(IERR .NE. 0) GOTO 9999
  153. ELSE
  154. C
  155. C**** Les normales ('MX ', ...)
  156. C Les tangentes ('RX ', ...)
  157. C
  158. TYPE = ' '
  159. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  160. IF (TYPE .NE. 'CHPOINT ') THEN
  161. CALL MATRAN(IDOMA,INORM)
  162. IF(IERR .NE. 0) GOTO 9999
  163. ENDIF
  164. JGN = 4
  165. JGM = 9
  166. SEGINI MLMVIT
  167. MLMVIT.MOTS(1) = 'MX '
  168. MLMVIT.MOTS(2) = 'MY '
  169. MLMVIT.MOTS(3) = 'MZ '
  170. MLMVIT.MOTS(4) = 'RX '
  171. MLMVIT.MOTS(5) = 'RY '
  172. MLMVIT.MOTS(6) = 'RZ '
  173. MLMVIT.MOTS(7) = 'UX '
  174. MLMVIT.MOTS(8) = 'UY '
  175. MLMVIT.MOTS(9) = 'UZ '
  176. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  177. SEGDES MLMVIT
  178. ENDIF
  179. c--------------------------------------------------------
  180. C**********************************
  181. C**** La table domaine du bord ****
  182. C**********************************
  183. C
  184. CALL LIROBJ('MMODEL ',MMODEL,1,IRET)
  185. CALL ACTOBJ('MMODEL ',MMODEL,1)
  186. IF(IERR.NE.0)GOTO 9999
  187. CALL LEKMOD(MMODEL,IDBOR,INEFMD)
  188. C INEFMD inutilisé
  189. IF(IERR .NE. 0)GOTO 9999
  190. C
  191. CALL LEKTAB(IDBOR,'CENTRE',MELECB)
  192. IF(IERR .NE. 0) GOTO 9999
  193. C
  194. TYPE = ' '
  195. CALL ACMO(IDBOR,'FACCEN',TYPE,MELEFC)
  196. IF (TYPE.NE.'MAILLAGE') THEN
  197. C
  198. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  199. IF(IERR .NE. 0) GOTO 9999
  200. C
  201. C******* On cree la connectivité face-centre
  202. C
  203. IPT1=MELECB
  204. IPT2=MELEFE
  205. SEGACT IPT1
  206. SEGACT IPT2
  207. CALL KRIPAD(IPT1,MLENTI)
  208. C SEGINI MLENTI
  209. NBELEM=IPT1.NUM(/2)
  210. NBNN=2
  211. NBSOUS=0
  212. NBREF=0
  213. SEGINI IPT3
  214. IPT3.ITYPEL=2
  215. N1=IPT2.NUM(/2)
  216. ICEN=0
  217. DO I1=1,N1,1
  218. NGF=IPT2.NUM(2,I1)
  219. NLC=MLENTI.LECT(NGF)
  220. IF(NLC.NE.0)THEN
  221. ICEN=ICEN+1
  222. IPT3.NUM(1,ICEN)=NGF
  223. IPT3.NUM(2,ICEN)=IPT2.NUM(1,I1)
  224. IF(IPT2.NUM(1,I1) .NE. IPT2.NUM(3,I1))THEN
  225. C Interior point
  226. C Donné incompatible
  227. WRITE(IOIMP,*) 'Internal boundary condition!!!'
  228. CALL ERREUR(21)
  229. ENDIF
  230. ENDIF
  231. ENDDO
  232. C
  233. IF(ICEN .NE. NBELEM)THEN
  234. CALL ERREUR(5)
  235. ENDIF
  236. SEGDES IPT1
  237. SEGDES IPT2
  238. SEGDES IPT3
  239. SEGDES MLENTI
  240. C
  241. MELEFC=IPT3
  242. CALL ECMO(IDBOR,'FACCEN','MAILLAGE',IPT3)
  243. ENDIF
  244. C-------------------------------------------------
  245. C**** Le SPG du residu
  246. C-------------------------------------------------
  247. IPT1=MELEFC
  248. SEGACT IPT1
  249. NBELEM=IPT1.NUM(/2)
  250. NBNN=1
  251. NBSOUS=0
  252. NBREF=0
  253. SEGINI IPT2
  254. IPT2.ITYPEL=1
  255. DO I1=1,NBELEM,1
  256. IPT2.NUM(1,I1)=IPT1.NUM(2,I1)
  257. ENDDO
  258. MELRES=IPT2
  259. SEGDES IPT1
  260. SEGDES IPT2
  261. C-------------------------------------------------
  262. C*** Reading the table PGAS *********************
  263. C-------------------------------------------------
  264. ICOND = 1
  265. CALL QUETYP(MTYPR,ICOND,IRETOU)
  266. IF(IERR .NE. 0)GOTO 9999
  267. IF(MTYPR .NE. 'TABLE ')THEN
  268. C---------------------------------------
  269. C Message d'erreur standard
  270. C 37 2
  271. C On ne trouve pas d'objet de type %m1:8
  272. C---------------------------------------
  273. MOTERR(1:8) = 'TABLE '
  274. CALL ERREUR(37)
  275. GOTO 9999
  276. ELSE
  277. ICOND = 1
  278. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  279. IF(IERR .NE. 0)GOTO 9999
  280. ENDIF
  281. C-------------------------------------------
  282. C******** Reading the CPs *****************
  283. C-------------------------------------------
  284. MTYPR = ' '
  285. CALL ACMO(IPGAS,'CP',MTYPR,ICP)
  286. IF(MTYPR .NE. 'TABLE ')THEN
  287. C--------------------------------
  288. C Message d'erreur standard
  289. C -301 0 %m1:40
  290. C--------------------------------
  291. MOTERR(1:40) = 'TAB1 . CP = ??? '
  292. WRITE(IOIMP,*) MOTERR(1:40)
  293. C---------------------------------
  294. C Message d'erreur standard
  295. C 21 2
  296. C Données incompatibles
  297. C--------------------------------
  298. CALL ERREUR(21)
  299. GOTO 9999
  300. ENDIF
  301. C-------------------------------------------
  302. C******** Reading the CVs *****************
  303. C-------------------------------------------
  304. MTYPR = ' '
  305. CALL ACMO(IPGAS,'CV',MTYPR,ICV)
  306. IF(MTYPR .NE. 'TABLE ')THEN
  307. C--------------------------------
  308. C Message d'erreur standard
  309. C -301 0 %m1:40
  310. C--------------------------------
  311. MOTERR(1:40) = 'TAB1 . CV = ??? '
  312. WRITE(IOIMP,*) MOTERR(1:40)
  313. C---------------------------------
  314. C Message d'erreur standard
  315. C 21 2
  316. C Données incompatibles
  317. C--------------------------------
  318. CALL ERREUR(21)
  319. GOTO 9999
  320. ENDIF
  321. C---------------------------------------------------------
  322. C Reading Les especes qui sont dans les Equations d'Euler
  323. C---------------------------------------------------------
  324. MTYPR = ' '
  325. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  326. IF(MTYPR .NE. 'LISTMOTS')THEN
  327. C---------------------------
  328. C Message d'erreur standard
  329. C -301 0 %m1:40
  330. C---------------------------
  331. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  332. WRITE(IOIMP,*) MOTERR(1:40)
  333. C---------------------------
  334. C Message d'erreur standard
  335. C 21 2
  336. C Données incompatibles
  337. C--------------------------
  338. CALL ERREUR(21)
  339. GOTO 9999
  340. ENDIF
  341. C-----------------------------------------------------------------
  342. C Reading Nom de l'espece qui n'est pas dans les equations d'Euler
  343. C-----------------------------------------------------------------
  344. MTYPI = 'MOT '
  345. MTYPR = ' '
  346. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
  347. & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR)
  348. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN
  349. C-------------------------------
  350. C Message d'erreur standard
  351. C -301 0 %m1:40
  352. C-------------------------------
  353. MOTERR = 'TAB1 . ESPNEULE = ??? '
  354. WRITE(IOIMP,*) MOTERR(1:40)
  355. C------------------------------
  356. C Message d'erreur standard
  357. C 21 2
  358. C Données incompatibles
  359. C------------------------------
  360. CALL ERREUR(21)
  361. GOTO 9999
  362. ENDIF
  363. C------------------------------
  364. SEGACT MLMOT1
  365. NESP = MLMOT1.MOTS(/2)
  366. NSP=NESP+1
  367. C----------------------
  368. C** List de CP et CV **
  369. C----------------------
  370. JG = NESP+1
  371. SEGINI MLRECP
  372. SEGINI MLRECV
  373. DO I1 = 1, NESP
  374. C-------------------------------
  375. C N.B. MOT1 est un CHARACTER*(4)
  376. C-------------------------------
  377. MOT1(1) = MLMOT1.MOTS(I1)
  378. MTYPI = 'MOT '
  379. MTYPR = ' '
  380. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  381. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  382. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  383. C------------------------------
  384. C Message d'erreur standard
  385. C -301 0 %m1:40
  386. C------------------------------
  387. MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? '
  388. WRITE(IOIMP,*) MOTERR(1:40)
  389. C------------------------------
  390. C Message d'erreur standard
  391. C 21 2
  392. C Données incompatibles
  393. C------------------------------
  394. CALL ERREUR(21)
  395. GOTO 9999
  396. ENDIF
  397. MLRECP.PROG(I1) = CP
  398. C-------------------------------------------
  399. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  400. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  401. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  402. C---------------------------
  403. C Message d'erreur standard
  404. C -301 0 %m1:40
  405. C---------------------------
  406. MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? '
  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. MLRECV.PROG(I1) = CV
  417. ENDDO
  418. MTYPI = 'MOT '
  419. MTYPR = ' '
  420. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  421. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  422. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  423. C---------------------------
  424. C Message d'erreur standard
  425. C -301 0 %m1:40
  426. C---------------------------
  427. MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? '
  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. ENDIF
  437. MLRECP.PROG(JG) = CP
  438. C
  439. MTYPI = 'MOT '
  440. MTYPR = ' '
  441. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  442. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  443. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  444. C----------------------------
  445. C Message d'erreur standard
  446. C -301 0 %m1:40
  447. C----------------------------
  448. MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? '
  449. WRITE(IOIMP,*) MOTERR(1:40)
  450. C----------------------------
  451. C Message d'erreur standard
  452. C 21 2
  453. C Données incompatibles
  454. C----------------------------
  455. CALL ERREUR(21)
  456. GOTO 9999
  457. ENDIF
  458. MLRECV.PROG(JG) = CV
  459. C-------------------------------------------------
  460. C**** Noms de variables conservatives
  461. C-------------------------------------------------
  462. TYPE='LISTMOTS'
  463. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  464. IF(IERR .NE. 0) GOTO 9999
  465. MLMOTS = ILIINC
  466. SEGACT MLMOTS
  467. NBCOMP = MLMOTS.MOTS(/2)
  468. SEGDES MLMOTS
  469. *---------------------------------------------
  470. IF(NBCOMP .EQ. (IDIM+4+NESP)) IKEPS = 1
  471. IF(NBCOMP .EQ. (IDIM+5+NESP)) ICREB = 1
  472. *---------------------------------------------
  473. IF((IKEPS .EQ. 0) .AND. (ICREB .EQ. 0)) THEN
  474. IF(NBCOMP .NE. (IDIM+2+NESP))THEN
  475. MOTERR(1:40) = 'LISTINCO = ???'
  476. WRITE(IOIMP,*) MOTERR
  477. C-----------------------------
  478. C** Message d'erreur standard
  479. C 21 2
  480. C Données incompatibles
  481. C-----------------------------
  482. CALL ERREUR(21)
  483. GOTO 9999
  484. ENDIF
  485. ENDIF
  486. C--------------------------------------------------------
  487. C**** Noms de variables primitives
  488. C--------------------------------------------------------
  489. TYPE='LISTMOTS'
  490. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  491. IF(IERR .NE. 0) GOTO 9999
  492. MLMOTS = ILIINP
  493. SEGACT MLMOTS
  494. NBCOMP = MLMOTS.MOTS(/2)
  495. SEGDES MLMOTS
  496. IF((IKEPS .EQ. 0) .AND. (ICREB .EQ. 0)) THEN
  497. IF(NBCOMP .NE. (IDIM+2+NESP))THEN
  498. MOTERR(1:40) = 'LISTPRIM = ???'
  499. WRITE(IOIMP,*) MOTERR
  500. C-----------------------------
  501. C** Message d'erreur standard
  502. C 21 2
  503. C Données incompatibles
  504. C-----------------------------
  505. CALL ERREUR(21)
  506. GOTO 9999
  507. ENDIF
  508. ENDIF
  509. C--------------------------------------------------------
  510. C**** Lecture du CHPOINT RN
  511. C--------------------------------------------------------
  512. TYPE='CHPOINT '
  513. CALL LIROBJ(TYPE,IROC,1,IRET)
  514. CALL ACTOBJ(TYPE,IROC,1)
  515. IF (IERR.NE.0) GOTO 9999
  516. C-----------------------------
  517. C** Control du CHPOINT: QUEPOI
  518. C
  519. C INDIC = 1 -> on impose le pointeur du support geometrique
  520. C NBCOMP > 0 -> nombre des composantes
  521. C-----------------------------
  522. INDIC = 1
  523. NBCOMP = 1
  524. MOT = 'SCAL'
  525. CALL QUEPOI(IROC, MELEMC, INDIC, NBCOMP, MOT)
  526. IF(IERR .NE. 0)GOTO 9999
  527. C------------------------------------------------------
  528. C**** Lecture du CHPOINT VITC
  529. C------------------------------------------------------
  530. CALL LIROBJ('CHPOINT ',IVITC,1,IRET)
  531. CALL ACTOBJ('CHPOINT ',IVITC,1)
  532. IF (IERR.NE.0) GOTO 9999
  533. C-----------------------
  534. C**** Control du CHPOINT
  535. C-----------------------
  536. JGN = 4
  537. JGM = IDIM
  538. SEGINI MLMVIT
  539. MLMVIT.MOTS(1) = 'UX '
  540. MLMVIT.MOTS(2) = 'UY '
  541. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  542. CALL QUEPO1(IVITC, MELEMC, MLMVIT)
  543. SEGDES MLMVIT
  544. IF(IERR .NE. 0)GOTO 9999
  545. C-------------------------------------------------------
  546. C**** Lecture du CHPOINT PC
  547. C-------------------------------------------------------
  548. CALL LIROBJ('CHPOINT ',IPC,1,IRET)
  549. CALL ACTOBJ('CHPOINT ',IPC,1)
  550. IF (IERR.NE.0) GOTO 9999
  551. C-----------------------
  552. C**** Control du CHPOINT
  553. C-----------------------
  554. INDIC = 1
  555. NBCOMP = 1
  556. MOT = 'SCAL'
  557. CALL QUEPOI(IPC, MELEMC, INDIC, NBCOMP, MOT)
  558. IF(IERR .NE. 0)GOTO 9999
  559. C-----------------------------
  560. C*** Fraction massiques
  561. C*** des especes "splittees"
  562. C-----------------------------
  563. TYPE = 'CHPOINT '
  564. CALL LIROBJ(TYPE,IYN,1,IRET)
  565. CALL ACTOBJ(TYPE,IYN,1)
  566. IF(IERR .NE. 0) GOTO 9999
  567. CALL QUEPO1(IYN, MELEMC, MLMOT1)
  568. IF(IERR .NE. 0) THEN
  569. MOTERR = 'CHPO FR.MAS. = ?????'
  570. WRITE(IOIMP,*) MOTERR(1:40)
  571. CALL ERREUR(21)
  572. GOTO 9999
  573. ENDIF
  574. C-----------------------------------
  575. c Turbulent kinetic energy
  576. c-----------------------------------
  577. IF((IKEPS .GT. 0) .OR. (ICREB .GT. 0)) THEN
  578. TYPE = 'CHPOINT '
  579. CALL LIROBJ(TYPE,IKAN,1,IRET)
  580. CALL ACTOBJ(TYPE,IKAN,1)
  581. INDIC = 1
  582. NBCOMP = 1
  583. MOT = 'SCAL'
  584. CALL QUEPOI(IKAN, MELEMC, INDIC, NBCOMP, MOT)
  585. IF(IERR .NE. 0)GOTO 9999
  586. C--------------------------------------
  587. c Rate of Turbulent energy dissipation
  588. c--------------------------------------
  589. TYPE = 'CHPOINT '
  590. CALL LIROBJ(TYPE,IEPSN,1,IRET)
  591. CALL ACTOBJ(TYPE,IEPSN,1)
  592. INDIC = 1
  593. NBCOMP = 1
  594. MOT = 'SCAL'
  595. CALL QUEPOI(IEPSN, MELEMC, INDIC, NBCOMP, MOT)
  596. IF(IERR .NE. 0)GOTO 9999
  597. ENDIF
  598. C--------------------------------------
  599. c K0 K0 K0 K0
  600. c--------------------------------------
  601. IF(ICREB .GT. 0) THEN
  602. TYPE = 'CHPOINT '
  603. CALL LIROBJ(TYPE,IK0N,1,IRET)
  604. CALL ACTOBJ(TYPE,IK0N,1)
  605. INDIC = 1
  606. NBCOMP = 1
  607. MOT = 'SCAL'
  608. CALL QUEPOI(IK0N, MELEMC, INDIC, NBCOMP, MOT)
  609. IF(IERR .NE. 0)GOTO 9999
  610. ELSE
  611. IK0N = 0
  612. ENDIF
  613. C------------------------------------------------------
  614. C**** CHPOINT condition limite
  615. C------------------------------------------------------
  616. CALL LIROBJ('CHPOINT ',ICHLIM,1,IRET)
  617. CALL ACTOBJ('CHPOINT ',ICHLIM,1)
  618. IF (IERR.NE.0) GOTO 9999
  619. C-----------------------------------------------------
  620. C**** Resultats
  621. C-----------------------------------------------------
  622. IF(IJAC .EQ.0)THEN
  623. TYPE=' '
  624. CALL KRCHP1(TYPE,MELRES,ICHRES,ILIINC)
  625. C
  626. TYPE=' '
  627. CALL KRCHP1(TYPE,MELECB,ICHRLI,ILIINP)
  628. ELSE
  629. ICHRES=0
  630. ICHRLI=0
  631. ENDIF
  632. C---------------------------------------------------------
  633. C**** TYPE DE CONDITION LIMITE
  634. C---------------------------------------------------------
  635. CALL LIRMOT(LOPT,NBOPT,ILIM,1)
  636. IF(IERR .NE. 0) GOTO 9999
  637. IF(ILIM .EQ. 1)THEN
  638. C-------------------------------------------------
  639. C******** 'INRI ' ????????????????????????????
  640. C-------------------------------------------------
  641. JGN = 4
  642. JGM = IDIM+2+NESP
  643. IF(IKEPS .GT. 0) JGM = IDIM+4+NESP
  644. SEGINI MLMVIT
  645. MLMOTS = ILIINP
  646. SEGACT MLMOTS
  647. NBCOMP = MLMOTS.MOTS(/2)
  648. DO 7 I=1,NBCOMP
  649. MLMVIT.MOTS(I)=MLMOTS.MOTS(I)
  650. 7 CONTINUE
  651. SEGDES MLMOTS
  652. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  653. SEGDES MLMVIT
  654. IF (IERR.NE.0) GOTO 9999
  655. C--------------------------------------------------------
  656. IF(IJAC.EQ.0)THEN
  657. IF(IKEPS .GT. 0) THEN
  658. CALL CL221T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO
  659. $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,IKAN,IEPSN
  660. $ ,ICHLIM,ICHRES,ICHRLI)
  661. ELSE
  662. CALL CLI221(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO
  663. $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM
  664. $ ,ICHRES,ICHRLI)
  665. ENDIF
  666. ELSE
  667. IF(IDIM.EQ.2)THEN
  668. CALL CLI223(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  669. & ICHPVO,ICHPSU,MLRECP,MLRECV,
  670. & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  671. ENDIF
  672. IF(IERR.NE.0)GOTO 9999
  673. ENDIF
  674. ELSEIF(ILIM .EQ. 2)THEN
  675. C-------------------------------------------------
  676. C******** 'OUTRI '
  677. C-------------------------------------------------
  678. JGN = 4
  679. JGM = IDIM+2+NESP
  680. SEGINI MLMVIT
  681. MLMOTS = ILIINP
  682. SEGACT MLMOTS
  683. NBCOMP = MLMOTS.MOTS(/2)
  684. DO 77 I=1,NBCOMP
  685. MLMVIT.MOTS(I)=MLMOTS.MOTS(I)
  686. 77 CONTINUE
  687. SEGDES MLMOTS
  688. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  689. SEGDES MLMVIT
  690. IF (IERR.NE.0) GOTO 9999
  691. C--------------------------------------------------------
  692. IF(IJAC.EQ.0)THEN
  693. CALL CLI222(NSP,MELEMF,MELEMC,MELECB,
  694. & MELEFC,INORM,ICHPVO,ICHPSU,
  695. & MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES,ICHRLI)
  696. IF(IERR.NE.0)GOTO 9999
  697. ENDIF
  698. C--------------------------------------------------------
  699. ELSEIF(ILIM .EQ. 3)THEN
  700. C------------------------
  701. C******** 'INJE '
  702. C------------------------
  703. JGN = 4
  704. JGM = 2+NESP
  705. SEGINI MLMVIT
  706. MLMVIT.MOTS(1) = 'MOME'
  707. MLMVIT.MOTS(2) = 'RT '
  708. MLMOTS = ILIINP
  709. SEGACT MLMOTS
  710. DO 78 I=1,NESP
  711. MLMVIT.MOTS(2+I)=MLMOTS.MOTS(IDIM+2+I)
  712. 78 CONTINUE
  713. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  714. SEGDES MLMVIT
  715. IF (IERR.NE.0) GOTO 9999
  716. C-----------------------------------------------------
  717. C-----------------------------------------------------
  718. IF(IJAC.EQ.0)THEN
  719. CALL CLI271(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  720. & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,ICHLIM,ICHRES
  721. $ ,ICHRLI)
  722. IF(IERR.NE.0)GOTO 9999
  723. ELSE
  724. IF(IDIM.EQ.2)THEN
  725. CALL CLI272(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  726. & ICHPVO,ICHPSU,MLRECP,MLRECV,
  727. & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  728. c ELSE
  729. c CALL CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  730. c $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  731. c $ ,ILIINP,IJAC,IJACO)
  732. ENDIF
  733. ENDIF
  734. C--------------------------
  735. C**** 'OUTP ' *********
  736. C--------------------------
  737. ELSEIF(ILIM .EQ. 4)THEN
  738. JGN = 4
  739. JGM = 1
  740. SEGINI MLMVIT
  741. MLMVIT.MOTS(1)='PN '
  742. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  743. SEGDES MLMVIT
  744. IF (IERR.NE.0) GOTO 9999
  745. C
  746. IF(IJAC.EQ.0)THEN
  747. IF((IKEPS .GT. 0) .OR. (ICREB .GT. 0)) THEN
  748. CALL CL251T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  749. & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,
  750. & IKAN,IEPSN,IK0N,ICHLIM,ICHRES,ICHRLI)
  751. ELSE
  752. CALL CLI251(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  753. & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM
  754. $ ,ICHRES,ICHRLI)
  755. ENDIF
  756. IF(IERR.NE.0)GOTO 9999
  757. ELSE
  758. IF(IDIM.EQ.2)THEN
  759. CALL CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  760. & ICHPVO,ICHPSU,MLRECP,MLRECV,
  761. & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  762. ENDIF
  763. ENDIF
  764. ELSEIF(ILIM .EQ. 5)THEN
  765. C-----------------------------
  766. C******** 'INSU '
  767. C-----------------------------
  768. JGN = 4
  769. JGM = 2+NESP
  770. SEGINI MLMVIT
  771. MLMVIT.MOTS(1) = 'HT '
  772. MLMVIT.MOTS(2) = 'S '
  773. MLMOTS = ILIINP
  774. SEGACT MLMOTS
  775. DO 79 I=1,NESP
  776. MLMVIT.MOTS(2+I)=MLMOTS.MOTS(IDIM+2+I)
  777. 79 CONTINUE
  778. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  779. SEGDES MLMVIT
  780. IF (IERR.NE.0) GOTO 9999
  781. C
  782. IF(IJAC.EQ.0)THEN
  783. CALL CLI261(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  784. & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES
  785. $ ,ICHRLI)
  786. IF(IERR.NE.0)GOTO 9999
  787. ELSE
  788. IF(IDIM.EQ.2)THEN
  789. CALL CLI262(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  790. & ICHPVO,ICHPSU,MLRECP,MLRECV,
  791. & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  792. ENDIF
  793. ENDIF
  794. ELSEIF(ILIM .EQ. 6)THEN
  795. C-------------------------------------------------
  796. C******** 'INOU '
  797. C-------------------------------------------------
  798. JGN = 4
  799. JGM = NESP+3
  800. SEGINI MLMVIT
  801. MLMVIT.MOTS(1) = 'HT '
  802. MLMVIT.MOTS(2) = 'S '
  803. MLMOTS = ILIINP
  804. SEGACT MLMOTS
  805. DO 770 I=1,NESP
  806. MLMVIT.MOTS(I+2)=MLMOTS.MOTS(IDIM+2+I)
  807. 770 CONTINUE
  808. MLMVIT.MOTS(3+NESP)= 'PN '
  809. SEGDES MLMOTS
  810. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  811. SEGDES MLMVIT
  812. IF (IERR.NE.0) GOTO 9999
  813. C--------------------------------------------------------
  814. IF(IJAC.EQ.0)THEN
  815. CALL CLI281(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO
  816. $ ,ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES
  817. $ ,ICHRLI)
  818. IF(IERR.NE.0)GOTO 9999
  819. ELSE
  820. IF(IDIM.EQ.2)THEN
  821. CALL CLI282(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  822. & ICHPVO,ICHPSU,MLRECP,MLRECV,
  823. & IROC,IVITC,IPC,IYN,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  824. ENDIF
  825. ENDIF
  826. C--------------------------------------------------------
  827. ELSEIF(ILIM .EQ. 7)THEN
  828. C--------------------------------------
  829. C****** 'INSS' **********************
  830. C--------------------------------------
  831. JGN = 4
  832. JGM = IDIM+2+NESP
  833. IF(IKEPS .GT. 0) JGM = IDIM+4+NESP
  834. SEGINI MLMVIT
  835. MLMOTS = ILIINP
  836. SEGACT MLMOTS
  837. NBCOMP = MLMOTS.MOTS(/2)
  838. DO 775 I=1,NBCOMP
  839. MLMVIT.MOTS(I)=MLMOTS.MOTS(I)
  840. 775 CONTINUE
  841. SEGDES MLMOTS
  842. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  843. SEGDES MLMVIT
  844. IF (IERR.NE.0) GOTO 9999
  845. C--------------------------------------------------------
  846. IF(IJAC.EQ.0)THEN
  847. IF(IKEPS .GT. 0) THEN
  848. CALL CL281T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO
  849. $ ,ICHPSU,MLRECP,MLRECV,ICHLIM,ICHRES,ICHRLI)
  850. ENDIF
  851. ENDIF
  852. C--------------------------
  853. C**** 'OUTSS ' *********
  854. C--------------------------
  855. ELSEIF(ILIM .EQ. 8)THEN
  856. IF(IJAC.EQ.0)THEN
  857. IF(IKEPS .GT. 0) THEN
  858. CALL CL291T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  859. & ICHPSU,MLRECP,MLRECV,IROC,IVITC,IPC,IYN,
  860. & IKAN,IEPSN,ICHLIM,ICHRES,ICHRLI)
  861. ENDIF
  862. ENDIF
  863. ELSEIF(ILIM .EQ. 9)THEN
  864. C-------------------------------------------------
  865. C******** 'RESE ' ****************************
  866. C-------------------------------------------------
  867. IF((IJAC .NE. 0) .OR. (IKEPS .NE. 0) .OR. (ICREB .GT. 0)) THEN
  868. WRITE(IOIMP,*) 'RESI implemented in explicit case only!'
  869. WRITE(IOIMP,*) 'No passive scalars!'
  870. CALL ERREUR(21)
  871. C Données incompatibles
  872. GOTO 9999
  873. ENDIF
  874. C
  875. C
  876. JGN = 4
  877. JGM = 2+NESP
  878. SEGINI MLMVIT
  879. MLMOTS = ILIINP
  880. SEGACT MLMOTS
  881. MLMVIT.MOTS(1)='RN '
  882. MLMVIT.MOTS(2)='PN '
  883. C
  884. DO 8 I=1,NESP
  885. MLMVIT.MOTS(2+I)=MLMOTS.MOTS(2+I+IDIM)
  886. 8 CONTINUE
  887. SEGDES MLMOTS
  888. C
  889. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  890. SEGSUP MLMVIT
  891. IF (IERR.NE.0) GOTO 9999
  892. C
  893. CALL CLI22R(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU
  894. $ ,MLRECP,MLRECV,IPC,ICHLIM,ICHRES,ICHRLI)
  895. IF(IERR.NE.0)GOTO 9999
  896. C--------------------------------------------------------
  897. ENDIF
  898. C--------------------------------------------------------
  899. IF(IJAC .EQ. 0) THEN
  900. TYPE = 'CHPOINT '
  901. CALL ACTOBJ(TYPE,ICHRES,1)
  902. CALL ACTOBJ(TYPE,ICHRLI,1)
  903.  
  904. CALL ECROBJ(TYPE,ICHRES)
  905. CALL ECROBJ(TYPE,ICHRLI)
  906. ELSE
  907. CALL ECROBJ('MATRIK ',IJACO)
  908. ENDIF
  909. 9999 CONTINUE
  910. END
  911.  
  912.  
  913.  

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