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.  
  110. -INC PPARAM
  111. -INC CCOPTIO
  112. -INC SMLMOTS
  113. -INC SMCHPOI
  114. -INC SMELEME
  115. POINTEUR MLMVIT.MLMOTS
  116. C
  117. C**** Variables de COOPTIO
  118. C
  119. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  120. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  121. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  122. C & ,IECHO, IIMPI, IOSPI
  123. C & ,IDIM, IFICLE, IPREFI
  124. C & ,MCOORD
  125. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  126. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  127. C & ,NORINC,NORVAL,NORIND,NORVAD
  128. C & ,NUCROU, IPSAUV
  129. C
  130. INTEGER NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM
  131. & ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI
  132. & ,ICHPVO, INORM, INEFMD, ICOND
  133. & ,IJACO, ILIINC, ILIINP, NC, IFLIM, MELLIM, ICACCA
  134. & ,IIMPL, IRN, IVN, IPN, IGAMN, IUINF, IUPRI
  135. C
  136. PARAMETER (NBJAC=3)
  137. CHARACTER*8 TYPE, LJACO(NBJAC)
  138. CHARACTER*4 MOT
  139. CHARACTER*(40) MESERR
  140. DATA LJACO/'VLH ','AUSMPLUS','AUSMPLM '/
  141. C
  142. C**********************************
  143. C**** Lecture de l'objet MODELE ***
  144. C**********************************
  145. C
  146. ICOND = 1
  147. CALL QUETYP(TYPE,ICOND,IRET)
  148.  
  149. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  150. WRITE(6,*)' On attend un objet MMODEL'
  151. RETURN
  152. ENDIF
  153. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  154. IF(IERR.NE.0)GOTO 9999
  155. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  156. IF(IERR.NE.0)GOTO 9999
  157. C
  158. C**** Centre, FACE, FACEL, ELTFA
  159. C
  160. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  161. IF(IERR .NE. 0) GOTO 9999
  162. C
  163. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  164. IF(IERR .NE. 0) GOTO 9999
  165. C
  166. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  167. IF(IERR .NE. 0) GOTO 9999
  168. C
  169. CALL LEKTAB(IDOMA,'ELTFA',MELTFA)
  170. IF(IERR .NE. 0) GOTO 9999
  171. C
  172. C**** Lecture du CHPOINT contenant les surfaces des faces.
  173. C
  174. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  175. IF(IERR .NE. 0) GOTO 9999
  176. INDIC = 1
  177. NBCOMP = 1
  178. MOT = 'SCAL'
  179. CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  180. IF(IERR .NE. 0) GOTO 9999
  181. C
  182. C**** Lecture du CHPOINT contenant les diametres minimums.
  183. C
  184. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  185. IF(IERR .NE. 0) GOTO 9999
  186. INDIC = 1
  187. NBCOMP = 1
  188. MOT = 'SCAL'
  189. CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT)
  190. IF(IERR .NE. 0) GOTO 9999
  191. C
  192. C**** Lecture du CHPOINT contenant les volumes
  193. C
  194. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  195. IF(IERR .NE. 0) GOTO 9999
  196. INDIC = 1
  197. NBCOMP = 1
  198. MOT = 'SCAL'
  199. CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  200. IF(IERR .NE. 0) GOTO 9999
  201. C
  202. C**** Les normales aux faces
  203. C
  204. IF(IDIM .EQ. 2)THEN
  205. C Que les normales
  206. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  207. IF(IERR .NE. 0) GOTO 9999
  208. JGN = 4
  209. JGM = 2
  210. SEGINI MLMVIT
  211. MLMVIT.MOTS(1) = 'UX '
  212. MLMVIT.MOTS(2) = 'UY '
  213. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  214. SEGSUP MLMVIT
  215. IF(IERR .NE. 0) GOTO 9999
  216. ELSE
  217. C Les normales et les tangentes
  218. TYPE = ' '
  219. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  220. IF (TYPE .NE. 'CHPOINT ') THEN
  221. CALL MATRAN(IDOMA,INORM)
  222. IF(IERR .NE. 0) GOTO 9999
  223. ENDIF
  224. JGN = 4
  225. JGM = 9
  226. SEGINI MLMVIT
  227. MLMVIT.MOTS(1) = 'UX '
  228. MLMVIT.MOTS(2) = 'UY '
  229. MLMVIT.MOTS(3) = 'UZ '
  230. MLMVIT.MOTS(4) = 'RX '
  231. MLMVIT.MOTS(5) = 'RY '
  232. MLMVIT.MOTS(6) = 'RZ '
  233. MLMVIT.MOTS(7) = 'MX '
  234. MLMVIT.MOTS(8) = 'MY '
  235. MLMVIT.MOTS(9) = 'MZ '
  236. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  237. SEGSUP MLMVIT
  238. ENDIF
  239. C
  240. C********************************
  241. C**** Fin table domaine *********
  242. C********************************
  243. C
  244. NESP=0
  245. C
  246. C**** La list des inconnues duales (variables conservatives)
  247. C
  248. TYPE='LISTMOTS'
  249. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  250. IF(IERR .NE. 0) GOTO 9999
  251. MLMOTS = ILIINC
  252. SEGACT MLMOTS
  253. NC = MLMOTS.MOTS(/2)
  254. SEGDES MLMOTS
  255. IF(NC .NE. (IDIM+2+NESP))THEN
  256. MOTERR(1:40) = 'LISTINCO = ???'
  257. WRITE(IOIMP,*) MOTERR
  258. C
  259. C******* Message d'erreur standard
  260. C 21 2
  261. C Données incompatibles
  262. C
  263. CALL ERREUR(21)
  264. GOTO 9999
  265. ENDIF
  266. C
  267. C**** La list des inconnues primales (variables primitives)
  268. C
  269. TYPE='LISTMOTS'
  270. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  271. IF(IERR .NE. 0) GOTO 9999
  272. MLMOTS = ILIINP
  273. SEGACT MLMOTS
  274. NC = MLMOTS.MOTS(/2)
  275. SEGDES MLMOTS
  276. IF(NC .NE. (IDIM+2+NESP))THEN
  277. MOTERR(1:40) = 'LISTINCO = ???'
  278. WRITE(IOIMP,*) MOTERR
  279. C
  280. C******* Message d'erreur standard
  281. C 21 2
  282. C Données incompatibles
  283. C
  284. CALL ERREUR(21)
  285. GOTO 9999
  286. ENDIF
  287. C
  288. C**** Boundary condition
  289. C
  290. IRET=0
  291. TYPE='MAILLAGE'
  292. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  293. IF(IERR.NE.0)GOTO 9999
  294. IF(IRET .EQ. 0)THEN
  295. MELLIM = 0
  296. ELSE
  297. MELEME=IFLIM
  298. SEGACT MELEME
  299. ICACCA=MELEME.NUM(/2)
  300. IF(ICACCA .EQ. 0)THEN
  301. MELLIM = 0
  302. ELSE
  303. MELLIM = IFLIM
  304. ENDIF
  305. SEGDES MELEME
  306. ENDIF
  307. C
  308. C**** Type of Jacobian
  309. C
  310. CALL LIRMOT(LJACO,NBJAC,IIMPL,1)
  311. IF(IERR .NE. 0)GOTO 9999
  312.  
  313. C
  314. C******* La densité au centre
  315. C
  316. TYPE = 'CHPOINT '
  317. CALL LIROBJ(TYPE,IRN,1,IRET)
  318. IF(IERR .NE. 0) GOTO 9999
  319. C
  320. C**** Control du CHPOINT: QUEPOI
  321. C
  322. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  323. C N.B. Le CHPOINT peut changer de structure pour
  324. C avoir SPG = ICEN!!!!
  325. C INDIC = 0 -> on ne fait que verifier le support geometrique
  326. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  327. C
  328. C NBCOMP > 0 -> numero des composantes
  329. C
  330. C MOT = ' ' obligatoire s'on connais pas les noms des composantes
  331. C
  332. INDIC = 1
  333. NBCOMP = 1
  334. MOT = 'SCAL'
  335. CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  336. IF(IERR .NE. 0) GOTO 9999
  337. C
  338. C******* La vitesse au centre
  339. C
  340. TYPE = 'CHPOINT '
  341. CALL LIROBJ(TYPE,IVN,1,IRET)
  342. IF(IERR .NE. 0) GOTO 9999
  343. JGN = 4
  344. JGM = IDIM
  345. SEGINI MLMVIT
  346. MLMVIT.MOTS(1) = 'UX '
  347. MLMVIT.MOTS(2) = 'UY '
  348. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  349. CALL QUEPO1(IVN, MELEMC, MLMVIT)
  350. SEGSUP MLMVIT
  351. IF(IERR .NE. 0) GOTO 9999
  352. C
  353. C******* La pression au centre
  354. C
  355. TYPE = 'CHPOINT '
  356. CALL LIROBJ(TYPE,IPN,1,IRET)
  357. IF(IERR .NE. 0) GOTO 9999
  358. INDIC = 1
  359. NBCOMP = 1
  360. MOT = 'SCAL'
  361. CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
  362. IF(IERR .NE. 0) GOTO 9999
  363. C
  364. C******* Gamma au centre
  365. C
  366. TYPE = 'CHPOINT '
  367. CALL LIROBJ(TYPE,IGAMN,1,IRET)
  368. IF(IERR .NE. 0) GOTO 9999
  369. INDIC = 1
  370. NBCOMP = 1
  371. MOT = 'SCAL'
  372. CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT)
  373. IF(IERR .NE. 0) GOTO 9999
  374. C
  375. C**** Bas Mach
  376. C
  377. IF(IIMPL .EQ. 3)THEN
  378. TYPE = 'CHPOINT '
  379. C
  380. C******* Cut off 1
  381. C
  382. CALL LIROBJ(TYPE,IUINF,1,IRET)
  383. IF(IERR .NE. 0) GOTO 9999
  384. INDIC = 1
  385. NBCOMP = 1
  386. MOT = 'SCAL'
  387. CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT)
  388. IF(IERR .NE. 0) GOTO 9999
  389. C
  390. C******* Cut off 2
  391. C
  392. TYPE = 'CHPOINT '
  393. CALL LIROBJ(TYPE,IUPRI,1,IRET)
  394. IF(IERR .NE. 0) GOTO 9999
  395. INDIC = 1
  396. NBCOMP = 1
  397. MOT = 'SCAL'
  398. CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
  399. IF(IERR .NE. 0) GOTO 9999
  400. C
  401. ELSE
  402. IUINF=0
  403. IUPRI=0
  404. ENDIF
  405. C
  406. C******* Calcul du jacobien
  407. C
  408. IF(IIMPL .EQ. 1)THEN
  409. C
  410. C********** VLH
  411. C
  412. IF(IDIM .EQ. 2)THEN
  413. CALL KONJP1(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  414. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  415. IF(IERR .NE. 0) GOTO 9999
  416. ELSE
  417. CALL KONJP3(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  418. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  419. IF(IERR .NE. 0) GOTO 9999
  420. ENDIF
  421. ELSEIF(IIMPL .EQ. 2)THEN
  422. C
  423. C********** AUSM+
  424. C
  425. IF(IDIM .EQ. 2)THEN
  426. CALL KONJP2(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  427. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  428. IF(IERR .NE. 0) GOTO 9999
  429. ELSE
  430. CALL KONJP4(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
  431. $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
  432. IF(IERR .NE. 0) GOTO 9999
  433. ENDIF
  434. ELSEIF(IIMPL .EQ. 3)THEN
  435. C
  436. C********** AUSM+LM
  437. C
  438. IF(IDIM .EQ. 2)THEN
  439. CALL KONJP5(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM,
  440. $ ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE,
  441. $ MELLIM, IJACO)
  442. IF(IERR .NE. 0) GOTO 9999
  443. ELSE
  444. CALL ERREUR(251)
  445. ENDIF
  446. ELSE
  447. C Tentative d'utilisation d'une option non implémentée
  448. CALL ERREUR(251)
  449. GOTO 9999
  450. ENDIF
  451. C
  452. C**** Ecriture des resultats
  453. C
  454. TYPE='MATRIK '
  455. CALL ECROBJ(TYPE,IJACO)
  456. 9999 CONTINUE
  457. RETURN
  458. END
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  

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