Télécharger kfmm1.eso

Retour à la liste

Numérotation des lignes :

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

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