Télécharger kon18.eso

Retour à la liste

Numérotation des lignes :

  1. C KON18 SOURCE CHAT 05/01/13 00:59:13 5004
  2. SUBROUTINE KON18
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : KON17
  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 de la Matrix de preconditionnement
  14. C pour les variables primitives (rho, u,v,p)
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  19. C S. Kudriakov , DRN/DMT/SEMT/LTMF
  20. C************************************************************************
  21. C
  22. C APPELES (Calcul) :
  23. C
  24. C************************************************************************
  25. C
  26. C*** SYNTAXE
  27. C
  28. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  29. C un gaz parfait mono-constituent polytropique
  30. C
  31. C RMAT1 = 'KONV' 'VF' 'PERFMONO' 'GAMPRIM' MAIL1 LMOT1 LMOT2
  32. C CHPO1 CHPO2 CHPO3 CHPO4 CHPO5 CHPO6 ;
  33. C
  34. C ENTREES
  35. C
  36. C LMOT1 : objet de type LISTMOTS
  37. C Noms de composantes des variable duales de RMAT1.
  38. C Il contient dans l'ordre suivant: le noms de la densité,
  39. C du momentum, de l'énergie totale par unité de volume
  40. C
  41. C LMOT2 : objet de type LISTMOTS
  42. C Noms de composantes des variable primales de RMAT1.
  43. C Il contient dans l'ordre suivant: le noms de la densité,
  44. C de la vitesse, de la pression.
  45. C
  46. C MAIL1 : SPG
  47. C
  48. C CHPO0 : CHPOINT contenant le diametre de la cellule (pour le calcul
  49. C du pas de temps local).
  50. C
  51. C CHPO1 : CHPOINT contenant la masse volumique
  52. C (SPG = MAIL1, une seule composante,
  53. C 'SCAL').
  54. C
  55. C CHPO2 : CHPOINT contenant la vitesse
  56. C (SPG = MAIL1, deux/trois composantes
  57. C 'UX', 'UY', 'UZ')
  58. C
  59. C CHPO3 : CHPOINT contenant la pression du gaz
  60. C (SPG = MAIL1, une seule composante,
  61. C 'SCAL').
  62. C
  63. C CHPO4 : CHPOINT contenant le "gamma" du gaz
  64. C (SPG = MAIL1, une seule composante,
  65. C 'SCAL').
  66. C
  67. C CHPO5 : CHPOINT contenant la vitesse de "cut-off"
  68. C (SPG = MAIL1, une seule composante,
  69. C 'SCAL').
  70. C
  71. C CHPO6 : CHPOINT contenant la deuxieme vitesse de "cut-off"
  72. C (SPG = MAIL1, une seule composante,
  73. C 'SCAL').
  74. C
  75. C SORTIES
  76. C
  77. C RMAT1 : objet de type MATRIK
  78. C (SPG = MAIL1)
  79. C
  80. C************************************************************************
  81. C
  82. C HISTORIQUE (Anomalies et modifications éventuelles)
  83. C
  84. C HISTORIQUE :
  85. C
  86. C************************************************************************
  87. C
  88. IMPLICIT INTEGER(I-N)
  89. -INC CCOPTIO
  90. -INC SMLMOTS
  91. -INC SMCHPOI
  92. -INC SMELEME
  93. POINTEUR MLMVIT.MLMOTS
  94. C
  95. C**** Variables de COOPTIO
  96. C
  97. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  98. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  99. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  100. C & ,IECHO, IIMPI, IOSPI
  101. C & ,IDIM, IFICLE, IPREFI
  102. C & ,MCOORD
  103. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  104. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  105. C & ,NORINC,NORVAL,NORIND,NORVAD
  106. C & ,NUCROU, IPSAUV
  107. C
  108. INTEGER IRET, INDIC, NBCOMP, NESP, JGN, JGM
  109. & ,MELEMC, IDIAM
  110. & ,IJACO, ILIINC, ILIINP, NC
  111. & ,IRN, IVN, IPN, IGAMN, IUPRI, IUPRI2
  112. C
  113. CHARACTER*8 TYPE
  114. CHARACTER*4 MOT
  115. CHARACTER*(40) MESERR
  116. C
  117. C*******************************
  118. C**** La table domaine *********
  119. C*******************************
  120. C
  121. CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
  122. IF(IERR .NE. 0)GOTO 9999
  123. C
  124. NESP=0
  125. C
  126. C**** La list des inconnues duales (variables conservatives)
  127. C
  128. TYPE='LISTMOTS'
  129. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  130. IF(IERR .NE. 0) GOTO 9999
  131. MLMOTS = ILIINC
  132. SEGACT MLMOTS
  133. NC = MLMOTS.MOTS(/2)
  134. SEGDES MLMOTS
  135. IF(NC .NE. (IDIM+2+NESP))THEN
  136. MOTERR(1:40) = 'LISTINCO = ???'
  137. WRITE(IOIMP,*) MOTERR
  138. C
  139. C******* Message d'erreur standard
  140. C 21 2
  141. C Données incompatibles
  142. C
  143. CALL ERREUR(21)
  144. GOTO 9999
  145. ENDIF
  146. C
  147. C**** La list des inconnues primales (variables primitives)
  148. C
  149. TYPE='LISTMOTS'
  150. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  151. IF(IERR .NE. 0) GOTO 9999
  152. MLMOTS = ILIINP
  153. SEGACT MLMOTS
  154. NC = MLMOTS.MOTS(/2)
  155. SEGDES MLMOTS
  156. IF(NC .NE. (IDIM+2+NESP))THEN
  157. MOTERR(1:40) = 'LISTINCO = ???'
  158. WRITE(IOIMP,*) MOTERR
  159. C
  160. C******* Message d'erreur standard
  161. C 21 2
  162. C Données incompatibles
  163. C
  164. CALL ERREUR(21)
  165. GOTO 9999
  166. ENDIF
  167. C
  168. C**** Lecture du diametre minimum
  169. C
  170. CALL LIROBJ('CHPOINT',IDIAM,1,IRET)
  171. IF (IERR.NE.0) GOTO 9999
  172. C
  173. C**** Control du CHPOINT: QUEPOI
  174. C
  175. INDIC = 1
  176. NBCOMP = 1
  177. MOT = 'SCAL'
  178. CALL QUEPOI(IDIAM, MELEMC, INDIC, NBCOMP, MOT)
  179. C
  180. C**** La densité au centre
  181. C
  182. TYPE = 'CHPOINT '
  183. CALL LIROBJ(TYPE,IRN,1,IRET)
  184. IF(IERR .NE. 0) GOTO 9999
  185. C
  186. C**** Control du CHPOINT: QUEPOI
  187. C
  188. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  189. C N.B. Le CHPOINT peut changer de structure pour
  190. C avoir SPG = ICEN!!!!
  191. C INDIC = 0 -> on ne fait que verifier le support geometrique
  192. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  193. C
  194. C NBCOMP > 0 -> numero des composantes
  195. C
  196. C MOT = ' ' obligatoire s'on connais pas les noms des composantes
  197. C
  198. INDIC = 1
  199. NBCOMP = 1
  200. MOT = 'SCAL'
  201. CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  202. IF(IERR .NE. 0) GOTO 9999
  203. C
  204. C******* La vitesse au centre
  205. C
  206. TYPE = 'CHPOINT '
  207. CALL LIROBJ(TYPE,IVN,1,IRET)
  208. IF(IERR .NE. 0) GOTO 9999
  209. JGN = 4
  210. JGM = IDIM
  211. SEGINI MLMVIT
  212. MLMVIT.MOTS(1) = 'UX '
  213. MLMVIT.MOTS(2) = 'UY '
  214. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  215. CALL QUEPO1(IVN, MELEMC, MLMVIT)
  216. SEGSUP MLMVIT
  217. IF(IERR .NE. 0) GOTO 9999
  218. C
  219. C******* La pression au centre
  220. C
  221. TYPE = 'CHPOINT '
  222. CALL LIROBJ(TYPE,IPN,1,IRET)
  223. IF(IERR .NE. 0) GOTO 9999
  224. INDIC = 1
  225. NBCOMP = 1
  226. MOT = 'SCAL'
  227. CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
  228. IF(IERR .NE. 0) GOTO 9999
  229. C
  230. C******* Gamma au centre
  231. C
  232. TYPE = 'CHPOINT '
  233. CALL LIROBJ(TYPE,IGAMN,1,IRET)
  234. IF(IERR .NE. 0) GOTO 9999
  235. INDIC = 1
  236. NBCOMP = 1
  237. MOT = 'SCAL'
  238. CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT)
  239. IF(IERR .NE. 0) GOTO 9999
  240. C----------------------------------------------------
  241. C******* Vitess de "cut-off" au centre
  242. C----------------------------------------------------
  243. TYPE = 'CHPOINT '
  244. CALL LIROBJ(TYPE,IUPRI,1,IRET)
  245. IF(IERR .NE. 0) GOTO 9999
  246. INDIC = 1
  247. NBCOMP = 1
  248. MOT = 'SCAL'
  249. CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
  250. IF(IERR .NE. 0) GOTO 9999
  251. C----------------------------------------------------
  252. C******* Vitess de "cut-off" au centre
  253. C----------------------------------------------------
  254. TYPE = 'CHPOINT '
  255. CALL LIROBJ(TYPE,IUPRI2,1,IRET)
  256. IF(IERR .NE. 0) GOTO 9999
  257. INDIC = 1
  258. NBCOMP = 1
  259. MOT = 'SCAL'
  260. CALL QUEPOI(IUPRI2, MELEMC, INDIC, NBCOMP, MOT)
  261. IF(IERR .NE. 0) GOTO 9999
  262.  
  263. C
  264. C******* Calcul du jacobien
  265. C
  266. IF(IDIM .EQ. 2)THEN
  267. CALL KON181(MELEMC,IDIAM, ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,
  268. & IUPRI,IUPRI2,IJACO)
  269. IF(IERR .NE. 0) GOTO 9999
  270. ELSE
  271. CALL ERREUR(251)
  272. GOTO 9999
  273. ENDIF
  274. C
  275. C**** Ecriture des resultats
  276. C
  277. TYPE='MATRIK '
  278. CALL ECROBJ(TYPE,IJACO)
  279. 9999 CONTINUE
  280. RETURN
  281. END
  282.  
  283.  
  284.  
  285.  

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