Télécharger kon14.eso

Retour à la liste

Numérotation des lignes :

  1. C KON14 SOURCE CHAT 06/08/24 21:47:53 5529
  2. SUBROUTINE KON14
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : KON14
  8. C
  9. C DESCRIPTION : Subroutine appellée par KON1
  10. C
  11. C Modelisation 2D/3D des equations d'Euler
  12. C Calcul du jacobien par rapport aux
  13. C variables primitives
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C APPELES (Calcul) : KONJP1 (calcul du jacobien, gaz "calorically
  22. C perfect", monoespece, 2D, VLH)
  23. C KONJP2 (calcul du jacobien, gaz "calorically
  24. C perfect", monoespece, 2D, AUSMplus)
  25. C KONJP3 (calcul du jacobien, gaz "calorically
  26. C perfect", monoespece, 3D, VLH)
  27. C KONJP4 (calcul du jacobien, gaz "calorically
  28. C perfect", monoespece, 3D, AUSMplus)
  29. C KONJP5 (calcul du jacobien, gaz "calorically
  30. C perfect", monoespece, 2D
  31. C AUSMPLM)
  32. C
  33. C************************************************************************
  34. C
  35. C*** SYNTAXE
  36. C
  37. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  38. C un gaz parfait mono-constituent polytropique
  39. C
  40. C RMAT1 = 'KONV' 'VF' 'PERFMONO' 'JACOPRIM' MOD1 LMOT1 LMOT2
  41. C (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4 ;
  42. C
  43. C or (Bas MAch)
  44. C
  45. C RMAT1 = 'KONV' 'VF' 'PERFMONO' 'JACOPRIM' MOD1 LMOT1 LMOT2
  46. C (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4
  47. C CHPO5 CHPO6 ;
  48. C
  49. C ENTREES
  50. C
  51. C LMOT1 : objet de type LISTMOTS
  52. C Noms de composantes des variable duales de RMAT1.
  53. C Il contient dans l'ordre suivant: le noms de la densité,
  54. C du momentum, de l'énergie totale par unité de volume
  55. C
  56. C LMOT2 : objet de type LISTMOTS
  57. C Noms de composantes des variable primales de RMAT1.
  58. C Il contient dans l'ordre suivant: le noms de la densité,
  59. C de la vitesse, de la pression.
  60. C
  61. C MOD1 : objet modele de type Navier_Stokes
  62. C
  63. C MOT3 : objet de type MOT
  64. C 'VLH' : jacobien du residu pour la methode VLH
  65. C 'AUSMPLUUS' : jacobien du residu pour la methode AUSM+
  66. C 'AUSMPLM' : jacobien du residu pour la methode AUSM+ low
  67. C Mach
  68. C
  69. C (MAILIM): MAIILAGE de POI1 ou on ne veut pas calculer le FLUX convective
  70. C
  71. C CHPO1 : CHPOINT contenant la masse volumique
  72. C (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
  73. C 'SCAL').
  74. C
  75. C CHPO2 : CHPOINT contenant la vitesse
  76. C (SPG =('DOMA' MOD1 'CENTRE'), deux/trois composantes
  77. C 'UX', 'UY', 'UZ')
  78. C
  79. C CHPO3 : CHPOINT contenant la pression du gaz
  80. C (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
  81. C 'SCAL').
  82. C
  83. C CHPO4 : CHPOINT contenant le "gamma" du gaz
  84. C (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
  85. C 'SCAL').
  86. C
  87. C CHPO5 : CHPOINT contenant la premiere vitesse de cut-off
  88. C (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
  89. C 'SCAL').
  90. C
  91. C CHP06 : CHPOINT contenant la deuxieme vitesse de cut-off
  92. C (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
  93. C 'SCAL').
  94. C
  95. C SORTIES
  96. C
  97. C RMAT1 : objet de type MATRIK
  98. C (SPG =('DOMA' MOD1 'CENTRE'))
  99. C
  100. C************************************************************************
  101. C
  102. C HISTORIQUE (Anomalies et modifications éventuelles)
  103. C
  104. C HISTORIQUE :
  105. C
  106. C************************************************************************
  107. C
  108. IMPLICIT INTEGER(I-N)
  109. -INC CCOPTIO
  110. -INC SMLMOTS
  111. -INC SMCHPOI
  112. -INC SMELEME
  113. POINTEUR MLMVIT.MLMOTS
  114. C
  115. C**** Variables de COOPTIO
  116. C
  117. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  118. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  119. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  120. C & ,IECHO, IIMPI, IOSPI
  121. C & ,IDIM, IFICLE, IPREFI
  122. C & ,MCOORD
  123. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  124. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  125. C & ,NORINC,NORVAL,NORIND,NORVAD
  126. C & ,NUCROU, IPSAUV
  127. C
  128. INTEGER NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM
  129. & ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI
  130. & ,ICHPVO, INORM, INEFMD, ICOND
  131. & ,IJACO, ILIINC, ILIINP, NC, IFLIM, MELLIM, ICACCA
  132. & ,IIMPL, IRN, IVN, IPN, IGAMN, IUINF, IUPRI
  133. C
  134. PARAMETER (NBJAC=3)
  135. CHARACTER*8 TYPE, LJACO(NBJAC)
  136. CHARACTER*4 MOT
  137. CHARACTER*(40) MESERR
  138. DATA LJACO/'VLH ','AUSMPLUS','AUSMPLM '/
  139. C
  140. C**********************************
  141. C**** Lecture de l'objet MODELE ***
  142. C**********************************
  143. C
  144. ICOND = 1
  145. CALL QUETYP(TYPE,ICOND,IRET)
  146.  
  147. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  148. WRITE(6,*)' On attend un objet MMODEL'
  149. RETURN
  150. ENDIF
  151. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  152. IF(IERR.NE.0)GOTO 9999
  153. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  154. IF(IERR.NE.0)GOTO 9999
  155. C
  156. C**** Centre, FACE, FACEL, ELTFA
  157. C
  158. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  159. IF(IERR .NE. 0) GOTO 9999
  160. C
  161. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  162. IF(IERR .NE. 0) GOTO 9999
  163. C
  164. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  165. IF(IERR .NE. 0) GOTO 9999
  166. C
  167. CALL LEKTAB(IDOMA,'ELTFA',MELTFA)
  168. IF(IERR .NE. 0) GOTO 9999
  169. C
  170. C**** Lecture du CHPOINT contenant les surfaces des faces.
  171. C
  172. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  173. IF(IERR .NE. 0) GOTO 9999
  174. INDIC = 1
  175. NBCOMP = 1
  176. MOT = 'SCAL'
  177. CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  178. IF(IERR .NE. 0) GOTO 9999
  179. C
  180. C**** Lecture du CHPOINT contenant les diametres minimums.
  181. C
  182. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  183. IF(IERR .NE. 0) GOTO 9999
  184. INDIC = 1
  185. NBCOMP = 1
  186. MOT = 'SCAL'
  187. CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT)
  188. IF(IERR .NE. 0) GOTO 9999
  189. C
  190. C**** Lecture du CHPOINT contenant les volumes
  191. C
  192. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  193. IF(IERR .NE. 0) GOTO 9999
  194. INDIC = 1
  195. NBCOMP = 1
  196. MOT = 'SCAL'
  197. CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  198. IF(IERR .NE. 0) GOTO 9999
  199. C
  200. C**** Les normales aux faces
  201. C
  202. IF(IDIM .EQ. 2)THEN
  203. C Que les normales
  204. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  205. IF(IERR .NE. 0) GOTO 9999
  206. JGN = 4
  207. JGM = 2
  208. SEGINI MLMVIT
  209. MLMVIT.MOTS(1) = 'UX '
  210. MLMVIT.MOTS(2) = 'UY '
  211. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  212. SEGSUP MLMVIT
  213. IF(IERR .NE. 0) GOTO 9999
  214. ELSE
  215. C Les normales et les tangentes
  216. TYPE = ' '
  217. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  218. IF (TYPE .NE. 'CHPOINT ') THEN
  219. CALL MATRAN(IDOMA,INORM)
  220. IF(IERR .NE. 0) GOTO 9999
  221. ENDIF
  222. JGN = 4
  223. JGM = 9
  224. SEGINI MLMVIT
  225. MLMVIT.MOTS(1) = 'UX '
  226. MLMVIT.MOTS(2) = 'UY '
  227. MLMVIT.MOTS(3) = 'UZ '
  228. MLMVIT.MOTS(4) = 'RX '
  229. MLMVIT.MOTS(5) = 'RY '
  230. MLMVIT.MOTS(6) = 'RZ '
  231. MLMVIT.MOTS(7) = 'MX '
  232. MLMVIT.MOTS(8) = 'MY '
  233. MLMVIT.MOTS(9) = 'MZ '
  234. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  235. SEGSUP MLMVIT
  236. ENDIF
  237. C
  238. C********************************
  239. C**** Fin table domaine *********
  240. C********************************
  241. C
  242. NESP=0
  243. C
  244. C**** La list des inconnues duales (variables conservatives)
  245. C
  246. TYPE='LISTMOTS'
  247. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  248. IF(IERR .NE. 0) GOTO 9999
  249. MLMOTS = ILIINC
  250. SEGACT MLMOTS
  251. NC = MLMOTS.MOTS(/2)
  252. SEGDES MLMOTS
  253. IF(NC .NE. (IDIM+2+NESP))THEN
  254. MOTERR(1:40) = 'LISTINCO = ???'
  255. WRITE(IOIMP,*) MOTERR
  256. C
  257. C******* Message d'erreur standard
  258. C 21 2
  259. C Données incompatibles
  260. C
  261. CALL ERREUR(21)
  262. GOTO 9999
  263. ENDIF
  264. C
  265. C**** La list des inconnues primales (variables primitives)
  266. C
  267. TYPE='LISTMOTS'
  268. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  269. IF(IERR .NE. 0) GOTO 9999
  270. MLMOTS = ILIINP
  271. SEGACT MLMOTS
  272. NC = MLMOTS.MOTS(/2)
  273. SEGDES MLMOTS
  274. IF(NC .NE. (IDIM+2+NESP))THEN
  275. MOTERR(1:40) = 'LISTINCO = ???'
  276. WRITE(IOIMP,*) MOTERR
  277. C
  278. C******* Message d'erreur standard
  279. C 21 2
  280. C Données incompatibles
  281. C
  282. CALL ERREUR(21)
  283. GOTO 9999
  284. ENDIF
  285. C
  286. C**** Boundary condition
  287. C
  288. IRET=0
  289. TYPE='MAILLAGE'
  290. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  291. IF(IERR.NE.0)GOTO 9999
  292. IF(IRET .EQ. 0)THEN
  293. MELLIM = 0
  294. ELSE
  295. MELEME=IFLIM
  296. SEGACT MELEME
  297. ICACCA=MELEME.NUM(/2)
  298. IF(ICACCA .EQ. 0)THEN
  299. MELLIM = 0
  300. ELSE
  301. MELLIM = IFLIM
  302. ENDIF
  303. SEGDES MELEME
  304. ENDIF
  305. C
  306. C**** Type of Jacobian
  307. C
  308. CALL LIRMOT(LJACO,NBJAC,IIMPL,1)
  309. IF(IERR .NE. 0)GOTO 9999
  310.  
  311. C
  312. C******* La densité au centre
  313. C
  314. TYPE = 'CHPOINT '
  315. CALL LIROBJ(TYPE,IRN,1,IRET)
  316. IF(IERR .NE. 0) GOTO 9999
  317. C
  318. C**** Control du CHPOINT: QUEPOI
  319. C
  320. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  321. C N.B. Le CHPOINT peut changer de structure pour
  322. C avoir SPG = ICEN!!!!
  323. C INDIC = 0 -> on ne fait que verifier le support geometrique
  324. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  325. C
  326. C NBCOMP > 0 -> numero des composantes
  327. C
  328. C MOT = ' ' obligatoire s'on connais pas les noms des composantes
  329. C
  330. INDIC = 1
  331. NBCOMP = 1
  332. MOT = 'SCAL'
  333. CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  334. IF(IERR .NE. 0) GOTO 9999
  335. C
  336. C******* La vitesse au centre
  337. C
  338. TYPE = 'CHPOINT '
  339. CALL LIROBJ(TYPE,IVN,1,IRET)
  340. IF(IERR .NE. 0) GOTO 9999
  341. JGN = 4
  342. JGM = IDIM
  343. SEGINI MLMVIT
  344. MLMVIT.MOTS(1) = 'UX '
  345. MLMVIT.MOTS(2) = 'UY '
  346. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  347. CALL QUEPO1(IVN, MELEMC, MLMVIT)
  348. SEGSUP MLMVIT
  349. IF(IERR .NE. 0) GOTO 9999
  350. C
  351. C******* La pression au centre
  352. C
  353. TYPE = 'CHPOINT '
  354. CALL LIROBJ(TYPE,IPN,1,IRET)
  355. IF(IERR .NE. 0) GOTO 9999
  356. INDIC = 1
  357. NBCOMP = 1
  358. MOT = 'SCAL'
  359. CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
  360. IF(IERR .NE. 0) GOTO 9999
  361. C
  362. C******* Gamma au centre
  363. C
  364. TYPE = 'CHPOINT '
  365. CALL LIROBJ(TYPE,IGAMN,1,IRET)
  366. IF(IERR .NE. 0) GOTO 9999
  367. INDIC = 1
  368. NBCOMP = 1
  369. MOT = 'SCAL'
  370. CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT)
  371. IF(IERR .NE. 0) GOTO 9999
  372. C
  373. C**** Bas Mach
  374. C
  375. IF(IIMPL .EQ. 3)THEN
  376. TYPE = 'CHPOINT '
  377. C
  378. C******* Cut off 1
  379. C
  380. CALL LIROBJ(TYPE,IUINF,1,IRET)
  381. IF(IERR .NE. 0) GOTO 9999
  382. INDIC = 1
  383. NBCOMP = 1
  384. MOT = 'SCAL'
  385. CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT)
  386. IF(IERR .NE. 0) GOTO 9999
  387. C
  388. C******* Cut off 2
  389. C
  390. TYPE = 'CHPOINT '
  391. CALL LIROBJ(TYPE,IUPRI,1,IRET)
  392. IF(IERR .NE. 0) GOTO 9999
  393. INDIC = 1
  394. NBCOMP = 1
  395. MOT = 'SCAL'
  396. CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
  397. IF(IERR .NE. 0) GOTO 9999
  398. C
  399. ELSE
  400. IUINF=0
  401. IUPRI=0
  402. ENDIF
  403. C
  404. C******* Calcul du jacobien
  405. C
  406. IF(IIMPL .EQ. 1)THEN
  407. C
  408. C********** VLH
  409. C
  410. IF(IDIM .EQ. 2)THEN
  411. CALL KONJP1(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  412. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  413. IF(IERR .NE. 0) GOTO 9999
  414. ELSE
  415. CALL KONJP3(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  416. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  417. IF(IERR .NE. 0) GOTO 9999
  418. ENDIF
  419. ELSEIF(IIMPL .EQ. 2)THEN
  420. C
  421. C********** AUSM+
  422. C
  423. IF(IDIM .EQ. 2)THEN
  424. CALL KONJP2(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  425. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  426. IF(IERR .NE. 0) GOTO 9999
  427. ELSE
  428. CALL KONJP4(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  429. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  430. IF(IERR .NE. 0) GOTO 9999
  431. ENDIF
  432. ELSEIF(IIMPL .EQ. 3)THEN
  433. C
  434. C********** AUSM+LM
  435. C
  436. IF(IDIM .EQ. 2)THEN
  437. CALL KONJP5(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM,
  438. $ ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE,
  439. $ MELLIM, IJACO)
  440. IF(IERR .NE. 0) GOTO 9999
  441. ELSE
  442. CALL ERREUR(251)
  443. ENDIF
  444. ELSE
  445. C Tentative d'utilisation d'une option non implémentée
  446. CALL ERREUR(251)
  447. GOTO 9999
  448. ENDIF
  449. C
  450. C**** Ecriture des resultats
  451. C
  452. TYPE='MATRIK '
  453. CALL ECROBJ(TYPE,IJACO)
  454. 9999 CONTINUE
  455. RETURN
  456. END
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  

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