Télécharger clim22.eso

Retour à la liste

Numérotation des lignes :

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

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