Télécharger kon12.eso

Retour à la liste

Numérotation des lignes :

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

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