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.  
  90. -INC PPARAM
  91. -INC CCOPTIO
  92. -INC SMLMOTS
  93. -INC SMCHPOI
  94. -INC SMELEME
  95. POINTEUR MLMVIT.MLMOTS
  96. C
  97. C**** Variables de COOPTIO
  98. C
  99. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  100. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  101. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  102. C & ,IECHO, IIMPI, IOSPI
  103. C & ,IDIM, IFICLE, IPREFI
  104. C & ,MCOORD
  105. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  106. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  107. C & ,NORINC,NORVAL,NORIND,NORVAD
  108. C & ,NUCROU, IPSAUV
  109. C
  110. INTEGER IRET, INDIC, NBCOMP, NESP, JGN, JGM
  111. & ,MELEMC, IDIAM
  112. & ,IJACO, ILIINC, ILIINP, NC
  113. & ,IRN, IVN, IPN, IGAMN, IUPRI, IUPRI2
  114. C
  115. CHARACTER*8 TYPE
  116. CHARACTER*4 MOT
  117. CHARACTER*(40) MESERR
  118. C
  119. C*******************************
  120. C**** La table domaine *********
  121. C*******************************
  122. C
  123. CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
  124. IF(IERR .NE. 0)GOTO 9999
  125. C
  126. NESP=0
  127. C
  128. C**** La list des inconnues duales (variables conservatives)
  129. C
  130. TYPE='LISTMOTS'
  131. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  132. IF(IERR .NE. 0) GOTO 9999
  133. MLMOTS = ILIINC
  134. SEGACT MLMOTS
  135. NC = MLMOTS.MOTS(/2)
  136. SEGDES MLMOTS
  137. IF(NC .NE. (IDIM+2+NESP))THEN
  138. MOTERR(1:40) = 'LISTINCO = ???'
  139. WRITE(IOIMP,*) MOTERR
  140. C
  141. C******* Message d'erreur standard
  142. C 21 2
  143. C Données incompatibles
  144. C
  145. CALL ERREUR(21)
  146. GOTO 9999
  147. ENDIF
  148. C
  149. C**** La list des inconnues primales (variables primitives)
  150. C
  151. TYPE='LISTMOTS'
  152. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  153. IF(IERR .NE. 0) GOTO 9999
  154. MLMOTS = ILIINP
  155. SEGACT MLMOTS
  156. NC = MLMOTS.MOTS(/2)
  157. SEGDES MLMOTS
  158. IF(NC .NE. (IDIM+2+NESP))THEN
  159. MOTERR(1:40) = 'LISTINCO = ???'
  160. WRITE(IOIMP,*) MOTERR
  161. C
  162. C******* Message d'erreur standard
  163. C 21 2
  164. C Données incompatibles
  165. C
  166. CALL ERREUR(21)
  167. GOTO 9999
  168. ENDIF
  169. C
  170. C**** Lecture du diametre minimum
  171. C
  172. CALL LIROBJ('CHPOINT',IDIAM,1,IRET)
  173. IF (IERR.NE.0) GOTO 9999
  174. C
  175. C**** Control du CHPOINT: QUEPOI
  176. C
  177. INDIC = 1
  178. NBCOMP = 1
  179. MOT = 'SCAL'
  180. CALL QUEPOI(IDIAM, MELEMC, INDIC, NBCOMP, MOT)
  181. C
  182. C**** La densité au centre
  183. C
  184. TYPE = 'CHPOINT '
  185. CALL LIROBJ(TYPE,IRN,1,IRET)
  186. IF(IERR .NE. 0) GOTO 9999
  187. C
  188. C**** Control du CHPOINT: QUEPOI
  189. C
  190. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  191. C N.B. Le CHPOINT peut changer de structure pour
  192. C avoir SPG = ICEN!!!!
  193. C INDIC = 0 -> on ne fait que verifier le support geometrique
  194. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  195. C
  196. C NBCOMP > 0 -> numero des composantes
  197. C
  198. C MOT = ' ' obligatoire s'on connais pas les noms des composantes
  199. C
  200. INDIC = 1
  201. NBCOMP = 1
  202. MOT = 'SCAL'
  203. CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
  204. IF(IERR .NE. 0) GOTO 9999
  205. C
  206. C******* La vitesse au centre
  207. C
  208. TYPE = 'CHPOINT '
  209. CALL LIROBJ(TYPE,IVN,1,IRET)
  210. IF(IERR .NE. 0) GOTO 9999
  211. JGN = 4
  212. JGM = IDIM
  213. SEGINI MLMVIT
  214. MLMVIT.MOTS(1) = 'UX '
  215. MLMVIT.MOTS(2) = 'UY '
  216. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  217. CALL QUEPO1(IVN, MELEMC, MLMVIT)
  218. SEGSUP MLMVIT
  219. IF(IERR .NE. 0) GOTO 9999
  220. C
  221. C******* La pression au centre
  222. C
  223. TYPE = 'CHPOINT '
  224. CALL LIROBJ(TYPE,IPN,1,IRET)
  225. IF(IERR .NE. 0) GOTO 9999
  226. INDIC = 1
  227. NBCOMP = 1
  228. MOT = 'SCAL'
  229. CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
  230. IF(IERR .NE. 0) GOTO 9999
  231. C
  232. C******* Gamma au centre
  233. C
  234. TYPE = 'CHPOINT '
  235. CALL LIROBJ(TYPE,IGAMN,1,IRET)
  236. IF(IERR .NE. 0) GOTO 9999
  237. INDIC = 1
  238. NBCOMP = 1
  239. MOT = 'SCAL'
  240. CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT)
  241. IF(IERR .NE. 0) GOTO 9999
  242. C----------------------------------------------------
  243. C******* Vitess de "cut-off" au centre
  244. C----------------------------------------------------
  245. TYPE = 'CHPOINT '
  246. CALL LIROBJ(TYPE,IUPRI,1,IRET)
  247. IF(IERR .NE. 0) GOTO 9999
  248. INDIC = 1
  249. NBCOMP = 1
  250. MOT = 'SCAL'
  251. CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
  252. IF(IERR .NE. 0) GOTO 9999
  253. C----------------------------------------------------
  254. C******* Vitess de "cut-off" au centre
  255. C----------------------------------------------------
  256. TYPE = 'CHPOINT '
  257. CALL LIROBJ(TYPE,IUPRI2,1,IRET)
  258. IF(IERR .NE. 0) GOTO 9999
  259. INDIC = 1
  260. NBCOMP = 1
  261. MOT = 'SCAL'
  262. CALL QUEPOI(IUPRI2, MELEMC, INDIC, NBCOMP, MOT)
  263. IF(IERR .NE. 0) GOTO 9999
  264.  
  265. C
  266. C******* Calcul du jacobien
  267. C
  268. IF(IDIM .EQ. 2)THEN
  269. CALL KON181(MELEMC,IDIAM, ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,
  270. & IUPRI,IUPRI2,IJACO)
  271. IF(IERR .NE. 0) GOTO 9999
  272. ELSE
  273. CALL ERREUR(251)
  274. GOTO 9999
  275. ENDIF
  276. C
  277. C**** Ecriture des resultats
  278. C
  279. TYPE='MATRIK '
  280. CALL ECROBJ(TYPE,IJACO)
  281. 9999 CONTINUE
  282. RETURN
  283. END
  284.  
  285.  
  286.  
  287.  

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