Télécharger kon12.eso

Retour à la liste

Numérotation des lignes :

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

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