Télécharger kfmm2.eso

Retour à la liste

Numérotation des lignes :

  1. C KFMM2 SOURCE CHAT 05/01/13 00:55:45 5004
  2. SUBROUTINE KFMM2(IRN,IGN,IRETN,IGAMN,
  3. & ICHPSU,ICHPVO,INORM,
  4. & MELEMC,MELEMF,MELEFE,
  5. & MELLIM,ICHLIM,
  6. & ICHRES)
  7. C************************************************************************
  8. C
  9. C PROJET : CASTEM 2000
  10. C
  11. C NOM : KFMM2
  12. C
  13. C DESCRIPTION : Voir KFMM
  14. C
  15. C Cas deux dimensions, gaz "calorically perfect"
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  20. C
  21. C************************************************************************
  22. C ENTREES
  23. C
  24. C
  25. C
  26. C 1) Pointeurs des CHPOINTs
  27. C
  28. C IRN : CHPOINT 'CENTRE' contenant la masse volumique
  29. C
  30. C IGN : CHPOINT 'CENTRE' contenant la q.d.m.
  31. C
  32. C IRETN : CHPOINT 'CENTRE' contenant l'energie totale
  33. C
  34. C IGAMN : CHPOINT 'CENTRE' contenant le gamma
  35. C
  36. C ICHLIM : CHPOINT conditions aux bords
  37. C
  38. C 3) Pointeurs de CHPOINTs de la table DOMAINE
  39. C
  40. C ICHPSU : CHPOINT "FACE" contenant la surface des faces
  41. C
  42. C ICHPVO : CHPOINT "CENTRE" contenant le volume
  43. C de chaque element
  44. C
  45. C
  46. C 4) Pointeurs de MELEME de la table DOMAINE
  47. C
  48. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  49. C
  50. C MELEMF : MELEME 'FACE' du SPG des FACES
  51. C
  52. C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
  53. C
  54. C MELLIM : MELEME SPG conditions aux bords
  55. C
  56. C SORTIES
  57. C
  58. C ICHRES : resultat
  59. C
  60. C************************************************************************
  61. C
  62. C HISTORIQUE (Anomalies et modifications éventuelles)
  63. C
  64. C HISTORIQUE : Avril 2002 : creation
  65. C Janvier 2003: implementation de condition aux limites
  66. C
  67. C************************************************************************
  68. C
  69. C
  70. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  71. C GAMMA \in (1,3)
  72. C Y \in (0,1)
  73. C Si non il faut le faire!!!
  74. C
  75. C************************************************************************
  76. C
  77. C
  78. C**** Variables de COOPTIO
  79. C
  80. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  81. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  82. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  83. C & ,IECHO, IIMPI, IOSPI
  84. C & ,IDIM
  85. C & ,MCOORD
  86. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  87. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  88. C & ,NORINC,NORVAL,NORIND,NORVAD
  89. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  90. C
  91. IMPLICIT INTEGER(I-N)
  92. INTEGER IRN,IGN,IRETN,IGAMN,ICHPSU,ICHPVO,INORM
  93. & ,MELEMC,MELEMF,MELEFE,ICHRES,ISPG1,ISPG2,NFAC
  94. & ,IGEOMF,IGEOMC, NGCEG, NGCED, NGCF, NLCF, NLCF1, NLCEG, NLCED
  95. & ,MELLIM,ICHLIM,NLLIM
  96. REAL*8 ROG, RUXG, RUYG, UNG, RETG, GAMG, REC, PG, VOLG, UTG
  97. & , ROD, RUXD, RUYD, UND, RETD, GAMD, PD, VOLD, UTD
  98. & , CNX, CNY, CTX, CTY
  99. & , SURF, SIGMAF
  100. & , UXG, UYG, RHTG
  101. & , UXD, UYD, RHTD, COEF
  102. & ,FR, FRUX, FRUY, FRET
  103.  
  104. CHARACTER*8 TYPE
  105. C
  106. C**** LES INCLUDES
  107. C
  108. -INC CCOPTIO
  109. -INC SMCHPOI
  110. POINTEUR MPOVSU.MPOVAL
  111. & , MPORES.MPOVAL, MPOVOL.MPOVAL
  112. & , MPRN.MPOVAL, MPGN.MPOVAL, MPRETN.MPOVAL, MPGAMN.MPOVAL
  113. & , MPNORM.MPOVAL, MPLIM.MPOVAL
  114. -INC SMELEME
  115. -INC SMLMOTS
  116. -INC SMLENTI
  117. POINTEUR MLELIM.MLENTI
  118. C
  119. C**** Initialisation des MLENTI des conditions aux limites
  120. C
  121. C
  122. CALL KRIPAD(MELLIM,MLELIM)
  123. C SEGINI MLELIM
  124. C
  125. C**** Initialisation des MELEMEs
  126. C
  127. C 'CENTRE', 'FACEL'
  128. C
  129. IPT2 = MELEFE
  130. SEGACT IPT2
  131. NFAC = IPT2.NUM(/2)
  132. C
  133. C**** KRIPAD pour la correspondance global/local de centre
  134. C
  135. CALL KRIPAD(MELEMC,MLENT1)
  136. C
  137. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  138. C
  139. C Si i est le numero global d'un noeud de ICEN,
  140. C MLENT1.LECT(i) contient sa position, i.e.
  141. C
  142. C I = numero global du noeud centre
  143. C MLENT1.LECT(i) = numero local du noeud centre
  144. C
  145. C MLENT1 déjà activé, i.e.
  146. C
  147. C SEGINI MLENT1
  148. C
  149. C
  150. C**** KRIPAD pour la correspondance global/local de 'FACE'
  151. C
  152. CALL KRIPAD(MELEMF,MLENT2)
  153. C SEGINI MLENT2
  154. C
  155. C**** CHPOINTs de la table DOMAINE
  156. C
  157. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  158. CALL LICHT(ICHPVO,MPOVOL,TYPE,IGEOMC)
  159. CALL LICHT(INORM,MPNORM,TYPE,IGEOMC)
  160. C
  161. C**** LICHT active les MPOVALs en *MOD
  162. C
  163. C i.e.
  164. C
  165. C SEGACT MPOVSU*MOD
  166. C SEGACT MPOVOL*MOD
  167. C SEGACT MPNORM*MOD
  168. C
  169. CALL LICHT(ICHRES,MPORES,TYPE,IGEOMC)
  170. C SEGACT MPORES*MOD
  171. C
  172. C
  173. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  174. CALL LICHT(IGN,MPGN,TYPE,IGEOMC)
  175. CALL LICHT(IRETN,MPRETN,TYPE,IGEOMC)
  176. CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  177. CALL LICHT(ICHLIM,MPLIM,TYPE,MELLIM)
  178. C
  179. C SEGACT MPRN*MOD
  180. C SEGACT MPGN*MOD
  181. C SEGACT MPRETN*MOD
  182. C SEGACT MPGAMN*MOD
  183. C SEGACT MPLIM*MOD
  184. C
  185. IF(IGEOMF .NE. MELEMF)THEN
  186. WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  187. WRITE(IOIMP,*) 'Probleme de SPG'
  188. C 21 2
  189. C Données incompatibles
  190. CALL ERREUR(21)
  191. GOTO 9999
  192. ENDIF
  193. IF(IGEOMC .NE. MELEMC)THEN
  194. WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  195. WRITE(IOIMP,*) 'Probleme de SPG'
  196. C 21 2
  197. C Données incompatibles
  198. CALL ERREUR(21)
  199. GOTO 9999
  200. ENDIF
  201. C
  202. C
  203. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  204. C
  205. DO NLCF = 1, NFAC
  206. C
  207. C******* NLCF = numero local du centre de facel
  208. C NGCF = numero global du centre de facel
  209. C NLCF1 = numero local du centre de face
  210. C NGCEG = numero global du centre ELT "gauche"
  211. C NLCEG = numero local du centre ELT "gauche"
  212. C NGCED = numero global du centre ELT "droite"
  213. C NLCED = numero local du centre ELT "droite"
  214. C
  215. NGCEG = IPT2.NUM(1,NLCF)
  216. NGCED = IPT2.NUM(3,NLCF)
  217. NGCF = IPT2.NUM(2,NLCF)
  218. NLCF1 = MLENT2.LECT(NGCF)
  219. NLCEG = MLENT1.LECT(NGCEG)
  220. NLCED = MLENT1.LECT(NGCED)
  221. C
  222. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  223. C
  224. IF(NLCF .NE. NLCF1)THEN
  225. WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  226. WRITE(IOIMP,*) 'Probleme de SPG'
  227. C 21 2
  228. C Données incompatibles
  229. CALL ERREUR(21)
  230. GOTO 9999
  231. ENDIF
  232. C
  233. CNX = MPNORM.VPOCHA(NLCF,1)
  234. CNY = MPNORM.VPOCHA(NLCF,2)
  235. CTX = -1.0D0 * CNY
  236. CTY = CNX
  237. C
  238. C
  239. C******* Recuperation des Etats "gauche" et "droite"
  240. C
  241. ROG = MPRN.VPOCHA(NLCEG,1)
  242. RUXG = MPGN.VPOCHA(NLCEG,1)
  243. RUYG = MPGN.VPOCHA(NLCEG,2)
  244. UXG = RUXG / ROG
  245. UYG = RUYG / ROG
  246. UNG = (UXG * CNX) + (UYG * CNY)
  247. UTG = (UXG * CTX) + (UYG * CTY)
  248. RETG = MPRETN.VPOCHA(NLCEG,1)
  249. GAMG = MPGAMN.VPOCHA(NLCEG,1)
  250. REC = 0.5D0 * ((RUXG * RUXG) + (RUYG*RUYG))
  251. REC = REC / ROG
  252. PG = (GAMG - 1.0D0) * (RETG - REC)
  253. VOLG = MPOVOL.VPOCHA(NLCEG,1)
  254. C
  255. IF(NLCEG .NE. NLCED)THEN
  256. ROD = MPRN.VPOCHA(NLCED,1)
  257. RUXD = MPGN.VPOCHA(NLCED,1)
  258. RUYD = MPGN.VPOCHA(NLCED,2)
  259. UXD = RUXD / ROD
  260. UYD = RUYD / ROD
  261. UND = (UXD * CNX) + (UYD * CNY)
  262. RETD = MPRETN.VPOCHA(NLCED,1)
  263. GAMD = MPGAMN.VPOCHA(NLCED,1)
  264. REC = 0.5D0 * ((RUXD * RUXD) + (RUYD*RUYD))
  265. REC = REC / ROD
  266. PD = (GAMD - 1.0D0) * (RETD - REC)
  267. VOLD = MPOVOL.VPOCHA(NLCED,1)
  268. ELSE
  269. C Murs au condition aux limite
  270. NLLIM=MLELIM.LECT(NGCF)
  271. IF(NLLIM .EQ.0)THEN
  272. C Mur
  273. ROD = ROG
  274. UND = -1.0D0 * UNG
  275. UTD = UTG
  276. UXD = UND * CNX + UTD * CTX
  277. UYD = UND * CNY + UTD * CTY
  278. RUXD = UXD * ROD
  279. RUYD = UYD * ROD
  280. GAMD = GAMG
  281. RETD = RETG
  282. PD = PG
  283. VOLD = VOLG
  284. ELSE
  285. C Boundary
  286. ROD = MPLIM.VPOCHA(NLLIM,1)
  287. UXD = MPLIM.VPOCHA(NLLIM,2)
  288. UYD = MPLIM.VPOCHA(NLLIM,3)
  289. PD = MPLIM.VPOCHA(NLLIM,4)
  290. GAMD = GAMG
  291. UND = (UXD * CNX) + (UYD * CNY)
  292. RETD = ((1.0D0/(GAMD - 1.0D0))*PD)+
  293. & (0.5D0*ROD*((UXD*UXD)+(UYD*UYD)))
  294. VOLD = VOLG
  295. ENDIF
  296. ENDIF
  297. C
  298. RHTG=RETG+PG
  299. RHTD=RETD+PD
  300. C
  301. SURF = MPOVSU.VPOCHA(NLCF,1)
  302. SIGMAF = (0.5D0 * (GAMG + GAMD)) * (PG + PD) / (ROG + ROD)
  303. SIGMAF = SIGMAF ** 0.5D0
  304. SIGMAF = (0.5D0 * (ABS(UNG) + ABS(UND))) + SIGMAF
  305. C
  306. FR=(ROG*UNG)+(ROD*UND)
  307. FRUX=(ROG*UNG*UXG)+(ROD*UND*UXD)+((PG+PD)*CNX)
  308. FRUY=(ROG*UNG*UYG)+(ROD*UND*UYD)+((PG+PD)*CNY)
  309. FRET=(UNG*RHTG)+(UND*RHTD)
  310. C
  311. COEF=SURF/(2.0D0*VOLG)
  312. MPORES.VPOCHA(NLCEG,1) = MPORES.VPOCHA(NLCEG,1) +
  313. & (COEF * (FR - (SIGMAF * ROD)))
  314. MPORES.VPOCHA(NLCEG,2) = MPORES.VPOCHA(NLCEG,2) +
  315. & (COEF * (FRUX - (SIGMAF * ROD * UXD)))
  316. MPORES.VPOCHA(NLCEG,3) = MPORES.VPOCHA(NLCEG,3) +
  317. & (COEF * (FRUY - (SIGMAF * ROD * UYD)))
  318. MPORES.VPOCHA(NLCEG,4) = MPORES.VPOCHA(NLCEG,4) +
  319. & (COEF * (FRET - (SIGMAF * RETD)))
  320. C
  321. IF(NLCEG .NE. NLCED)THEN
  322. C
  323. C********** Domain interieur
  324. C
  325. COEF=SURF/(2.0D0*VOLD)
  326. MPORES.VPOCHA(NLCED,1) = MPORES.VPOCHA(NLCED,1) -
  327. & (COEF * (FR + (SIGMAF * ROG)))
  328. MPORES.VPOCHA(NLCED,2) = MPORES.VPOCHA(NLCED,2) -
  329. & (COEF * (FRUX + (SIGMAF * ROG * UXG)))
  330. MPORES.VPOCHA(NLCED,3) = MPORES.VPOCHA(NLCED,3) -
  331. & (COEF * (FRUY + (SIGMAF * ROG * UYG)))
  332. MPORES.VPOCHA(NLCED,4) = MPORES.VPOCHA(NLCED,4) -
  333. & (COEF * (FRET + (SIGMAF * RETG)))
  334. ENDIF
  335. ENDDO
  336. C
  337. SEGDES MPOVSU
  338. SEGDES MPOVOL
  339. SEGDES MPNORM
  340. C
  341. SEGDES MPORES
  342. C
  343. SEGDES MPRN
  344. SEGDES MPRETN
  345. SEGDES MPGN
  346. SEGDES MPGAMN
  347. C
  348. SEGSUP MLENT1
  349. SEGSUP MLENT2
  350. SEGDES IPT2
  351. C
  352. SEGSUP MLELIM
  353. IF(MPLIM .GT. 0) SEGDES MPLIM
  354. C
  355. C
  356. 9999 CONTINUE
  357. C
  358. RETURN
  359. END
  360. C
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  

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