Télécharger clim22.eso

Retour à la liste

Numérotation des lignes :

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

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