Télécharger konfl4.eso

Retour à la liste

Numérotation des lignes :

  1. C KONFL4 SOURCE PV 09/03/12 21:26:31 6325
  2. SUBROUTINE KONFL4(LOGME,LOGSCA,INDMET,NORDP1,
  3. & IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
  4. & ICHPSU,ICHPDI,
  5. & MELEMC,MELEMF,MELEFE,MELLIM,
  6. & ICHFLU,DT,
  7. & LOGNC,LOGAN,MESERR)
  8. C************************************************************************
  9. C
  10. C PROJET : CASTEM 2000
  11. C
  12. C NOM : KONFL4
  13. C
  14. C DESCRIPTION : Voir KONV12
  15. C
  16. C Cas trois dimensions, gaz "thermally perfect"
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : R. MOREL, A. BECCANTINI, DRN/DMT/SEMT/TTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C APPELES (Outils
  26. C CASTEM) : KRIPAD, LICHT
  27. C
  28. C APPELES (Calcul) : FVLHT2, FCOLT2
  29. C
  30. C
  31. C************************************************************************
  32. C
  33. C ENTREES
  34. C
  35. C
  36. C 1) PARAMETRES
  37. C
  38. C LOGME : (LOGICAL); .TRUE. -> MULTI-ESPECES
  39. C .FALSE. -> MONO-ESPECE
  40. C
  41. C LOGSCA : (LOGICAL); .TRUE. -> SCALAIRES-PASSIVES
  42. C .FALSE. -> ou non
  43. C
  44. C INDMET : 1 VLH (van Leer Hanel FVS)
  45. C
  46. C 2 Colella-Glaz FDS
  47. C
  48. C NORDP1 : (ordre des polynoms cv(T)) + 1
  49. C
  50. C 2) Pointeurs des MCHAMLs
  51. C
  52. C IROF : MCHAML sur "FACEL" contenant la masse volumique
  53. C ("gauche" et "droite");
  54. C
  55. C IVITF : MCHAML sur "FACEL" contenant la vitesse dans le repaire
  56. C local (n,t) et les cosinus directeurs des repaire local;
  57. C
  58. C IPF : MCHAML sur "FACEL" contenant la pression;
  59. C
  60. C IFRAMAF : MCHAML sur "FACEL", contenant les fractions massiques
  61. C si LOGME = .TRUE.;
  62. C LOGME = .FALSE. -> IFRAMAF = 0
  63. C
  64. C ISCAF : MCHAML sur "FACEL", contenant les scalires passifs a
  65. C transporter (ou ISCAF = 0)
  66. C
  67. C 3) Pointeur sur la table des proprietes de gaz
  68. C
  69. C PROPHY
  70. C
  71. C 4) Pointeurs de CHPOINTs de la table DOMAINE
  72. C
  73. C ICHPSU : CHPOINT "FACE" contenant la surface des faces
  74. C
  75. C ICHPDI : CHPOINT "CENTRE" contenant le diametre minimum
  76. C de chaque element
  77. C
  78. C
  79. C 5) Pointeurs de MELEME de la table DOMAINE
  80. C
  81. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  82. C
  83. C MELEMF : MELEME 'FACE' du SPG des FACES
  84. C
  85. C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
  86. C
  87. C MELLIM : MAILLAGE where the flux (or residu) will not be found
  88. C
  89. C SORTIES
  90. C
  91. C ICHFLU : pointeur du CHPOINT flux aux "FACE"s
  92. C
  93. C DT : pas de temps pour le respect de la CFL-like condition
  94. C DT < DIAMEL /2 /max(Lambda_i)
  95. C En maillage regulier cette condition garantie la
  96. C non-interaction des ondes
  97. C
  98. C
  99. C LOGNC : (LOGICAL): si .TRUE. la methode de Newton-Rapson, utilisée
  100. C dans pour la solution du probleme Riemann exacte ou dans
  101. C l'algorithm HUS, n'a pas bien marchéee; MESERR = 'Goudunov'
  102. C ou 'HUS'.
  103. C
  104. C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
  105. C
  106. C MESERR : pour l'ecriture des messages d'erreurs
  107. C
  108. C************************************************************************
  109. C
  110. C HISTORIQUE (Anomalies et modifications éventuelles)
  111. C
  112. C HISTORIQUE : 22.12.98 Creation
  113. C
  114. C 08.02.00 Ajout du flux numerique de Colella-Glaz
  115. C
  116. C 21.02.00 Ajout de transport de scalaires passifs
  117. C
  118. C 03.12.03 Ajout le MAILLIM comme le l'entree
  119. C
  120. C************************************************************************
  121. C
  122. C
  123. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  124. C GAMMA \in (1,3)
  125. C Y \in (0,1)
  126. C Si non il faut le faire!!!
  127. C
  128. C************************************************************************
  129. C
  130. C
  131. C**** Variables de COOPTIO
  132. C
  133. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  134. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  135. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  136. C & ,IECHO, IIMPI, IOSPI
  137. C & ,IDIM
  138. CC & ,MCOORD
  139. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  140. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  141. C & ,NORINC,NORVAL,NORIND,NORVAD
  142. C & ,NUCROU, IPSAUV
  143. C
  144. IMPLICIT INTEGER(I-N)
  145. INTEGER I1, I2
  146. & ,INDMET, NORDP1
  147. & ,IROF,IVITF,IPF,IFRMAF, ISCAF
  148. & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
  149. & ,IGEOMC,IGEOMF
  150. & ,ICHFLU
  151. & ,NESP, NFAC, NSCA, NMA, NMA2
  152. & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
  153. & ,NGCF, NLCF1, SPG1, SPG2, NLFL
  154. REAL*8 DT, UNSDT, CELLT
  155. & , ROG, UNG, UTG, UVG, PG, GAMG, TG
  156. & , ROD, UND, UTD, UVD, PD, GAMD, TD
  157. & , SURF,CNX, CNY, CNZ, CTX , CTY, CTZ
  158. & , CVX, CVY, CVZ
  159. & , CELL, DIAMG, DIAMD, DIAM
  160. & , ASON, LAMBDA
  161. & , Y1G, Y1D, RTOTG, RTOTD, CVTOTG, CVTOTD, ETHERG, ETHERD
  162. & , YG, YD, FUNTG, FUNTD, DCV, XST
  163. LOGICAL LOGME, LOGNC, LOGAN, LOGSCA
  164. CHARACTER*(40) MESERR
  165. CHARACTER*(8) TYPE
  166. C
  167. C**** Segment des proprietes du gaz
  168. C
  169. SEGMENT PROPHY
  170. REAL*8 ACV(NORDP1,NESP+1), R(NESP+1), H0K(NESP+1)
  171. & ,ACVTOG(NORDP1), ACVTOD(NORDP1)
  172. ENDSEGMENT
  173. C
  174. C**** Les Includes
  175. C
  176. C
  177. C**** LES INCLUDES
  178. C
  179. -INC CCOPTIO
  180. -INC SMCOORD
  181. -INC SMCHAML
  182. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,MELVNZ.MELVAL,
  183. & MELT1X.MELVAL, MELT1Y.MELVAL,MELT1Z.MELVAL,
  184. & MELT2X.MELVAL, MELT2Y.MELVAL,MELT2Z.MELVAL
  185. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
  186. POINTEUR MELRO.MELVAL, MELP.MELVAL
  187. -INC SMCHPOI
  188. POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  189. & , MPOFLU.MPOVAL
  190. POINTEUR MCHAMY.MCHAML, MCHAMS.MCHAML
  191. -INC SMELEME
  192. POINTEUR MELLIM.MELEME
  193. -INC SMLMOTS
  194. -INC SMLENTI
  195. POINTEUR MLELIM.MLENTI
  196. C
  197. C**** Les fractiones massiques.
  198. C
  199. SEGMENT FRAMAS
  200. REAL*8 YET(NMA)
  201. ENDSEGMENT
  202. POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS, SCAG.FRAMAS, SCAD.FRAMAS
  203. C
  204. C**** Les flux aux interface dans le repaire (n,t)
  205. C
  206. SEGMENT IFLUX
  207. REAL*8 FLUX(NMA2)
  208. ENDSEGMENT
  209. POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
  210. C--------------------------------------------
  211. CALL KRIPAD(MELLIM,MLELIM)
  212. C--------------------------------------------
  213. C
  214. C**** Initialisation des MCHAMLs
  215. C
  216. C**** Masse volumique
  217. C
  218. MCHEL1 = IROF
  219. SEGACT MCHEL1
  220. MCHAM1 = MCHEL1.ICHAML(1)
  221. SEGACT MCHAM1
  222. MELRO = MCHAM1.IELVAL(1)
  223. SEGDES MCHEL1
  224. SEGDES MCHAM1
  225. C
  226. C**** Pression
  227. C
  228. MCHEL1 = IPF
  229. SEGACT MCHEL1
  230. MCHAM1 = MCHEL1.ICHAML(1)
  231. SEGACT MCHAM1
  232. MELP = MCHAM1.IELVAL(1)
  233. SEGDES MCHEL1
  234. SEGDES MCHAM1
  235. C
  236. C**** Vitesse et cosinus directeurs du repere (n,t)
  237. C
  238. MCHEL1 = IVITF
  239. SEGACT MCHEL1
  240. C
  241. C**** La vitesse a comme SPG MELEFE
  242. C Le cosinus directeurs ont comme SPG MELEMF
  243. C
  244. C MCHAM1 -> Cosinus directeurs
  245. C MCHAM2 -> Vitesse
  246. C
  247. SPG1 = MCHEL1.IMACHE(1)
  248. SPG2 = MCHEL1.IMACHE(2)
  249. IF((SPG1 .EQ. MELEMF) .AND. (SPG2 .EQ. MELEFE))THEN
  250. MCHAM1 = MCHEL1.ICHAML(1)
  251. MCHAM2 = MCHEL1.ICHAML(2)
  252. ELSEIF((SPG1 .EQ. MELEFE) .AND. (SPG2 .EQ. MELEMF))THEN
  253. MCHAM1 = MCHEL1.ICHAML(2)
  254. MCHAM2 = MCHEL1.ICHAML(1)
  255. ELSE
  256. LOGAN = .TRUE.
  257. GOTO 9999
  258. ENDIF
  259. SEGACT MCHAM1
  260. MELVNX = MCHAM1.IELVAL(1)
  261. MELVNY = MCHAM1.IELVAL(2)
  262. MELVNZ = MCHAM1.IELVAL(3)
  263. MELT1X = MCHAM1.IELVAL(4)
  264. MELT1Y = MCHAM1.IELVAL(5)
  265. MELT1Z = MCHAM1.IELVAL(6)
  266. MELT2X = MCHAM1.IELVAL(7)
  267. MELT2Y = MCHAM1.IELVAL(8)
  268. MELT2Z = MCHAM1.IELVAL(9)
  269. SEGDES MCHAM1
  270. SEGACT MCHAM2
  271. MELVUN = MCHAM2.IELVAL(1)
  272. MELVUT = MCHAM2.IELVAL(2)
  273. MELVUV = MCHAM2.IELVAL(3)
  274. SEGDES MCHAM2
  275. SEGDES MCHEL1
  276. C
  277. C**** Fractions massiques
  278. C
  279. IF(LOGME)THEN
  280. MCHEL1 = IFRMAF
  281. SEGACT MCHEL1
  282. MCHAMY = MCHEL1.ICHAML(1)
  283. SEGACT MCHAMY
  284. C
  285. C******* Numero d'especes dans les equations d'Euler
  286. C
  287. NESP = MCHAMY.IELVAL(/1)
  288. DO I1 = 1, NESP
  289. MELVA1 = MCHAMY.IELVAL(I1)
  290. SEGACT MELVA1
  291. ENDDO
  292. NMA = NESP
  293. SEGINI FRAMAG
  294. SEGINI FRAMAD
  295. SEGDES MCHEL1
  296. ELSE
  297. C
  298. C******* Definition minimale de YET, necessaire pour transmetre YET aux
  299. C subroutines FORTRAN qui calculent les flux
  300. C
  301. NMA = 1
  302. SEGINI FRAMAG
  303. SEGINI FRAMAD
  304. NESP = 0
  305. ENDIF
  306. C
  307. C**** Scalaires passifs
  308. C
  309. IF(LOGSCA)THEN
  310. MCHEL1 = ISCAF
  311. SEGACT MCHEL1
  312. MCHAMS = MCHEL1.ICHAML(1)
  313. SEGACT MCHAMS
  314. NSCA = MCHAMS.IELVAL(/1)
  315. DO I1 = 1, NSCA, 1
  316. MELVA1 = MCHAMS.IELVAL(I1)
  317. SEGACT MELVA1
  318. ENDDO
  319. NMA = NSCA
  320. SEGINI SCAG
  321. SEGINI SCAD
  322. SEGDES MCHEL1
  323. ELSE
  324. C
  325. C******* Definition minimale de YET, necessaire pour transmetre YET aux
  326. C subroutines FORTRAN qui calculent les flux
  327. C
  328. NMA = 1
  329. SEGINI SCAG
  330. SEGINI SCAD
  331. NSCA= 0
  332. ENDIF
  333. C
  334. C
  335. C**** Initialisation des MELEMEs
  336. C
  337. C 'CENTRE', 'FACEL'
  338. C
  339. IPT2 = MELEFE
  340. SEGACT IPT2
  341. NFAC = IPT2.NUM(/2)
  342. C
  343. C**** KRIPAD pour la correspondance global/local de centre
  344. C
  345. CALL KRIPAD(MELEMC,MLENT1)
  346. C
  347. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  348. C
  349. C Si i est le numero global d'un noeud de ICEN,
  350. C MLENT1.LECT(i) contient sa position, i.e.
  351. C
  352. C I = numero global du noeud centre
  353. C MLENT1.LECT(i) = numero local du noeud centre
  354. C
  355. C MLENT1 déjà activé, i.e.
  356. C
  357. C SEGACT MLENT1
  358. C
  359. C
  360. C**** KRIPAD pour la correspondance global/local de 'FACE'
  361. C
  362. CALL KRIPAD(MELEMF,MLENT2)
  363. C
  364. C**** Initialisation de flux
  365. C
  366. NMA2 = 5 + NESP + NSCA
  367. SEGINI IFLU1
  368. SEGINI IFLU2
  369. C
  370. C**** IFLU2 = segment de travail en FLUVLH; c'est plus rapide le definir ici
  371. C
  372. C
  373. C**** CHPOINTs de la table DOMAINE
  374. C
  375. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  376. CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
  377. C
  378. C**** LICHT active les MPOVALs en *MOD
  379. C
  380. C i.e.
  381. C
  382. C SEGACT MPOVSU*MOD
  383. C SEGACT MPOVDI*MOD
  384. C
  385. C
  386. C**** Les FLUX aux face
  387. C
  388. CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
  389. C
  390. C SEGACT MPOFLU*MOD
  391. C
  392. C**** Activation des MCHAMLs
  393. C
  394. SEGACT MELRO
  395. SEGACT MELP
  396. SEGACT MELVUN
  397. SEGACT MELVUT
  398. SEGACT MELVUV
  399. SEGACT MELVNX
  400. SEGACT MELVNY
  401. SEGACT MELVNZ
  402. SEGACT MELT1X
  403. SEGACT MELT1Y
  404. SEGACT MELT1Z
  405. SEGACT MELT2X
  406. SEGACT MELT2Y
  407. SEGACT MELT2Z
  408. C
  409. C**** Initialisation de 1/DT
  410. C
  411. UNSDT = 0.0D0
  412. C
  413. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  414. C
  415. DO NLCF = 1, NFAC
  416. C
  417. C******* NLCF = numero local du centre de facel
  418. C NGCF = numero global du centre de facel
  419. C NLCF1 = numero local du centre de face
  420. C NGCEG = numero global du centre ELT "gauche"
  421. C NLCEG = numero local du centre ELT "gauche"
  422. C NGCED = numero global du centre ELT "droite"
  423. C NLCED = numero local du centre ELT "droite"
  424. C
  425. NGCEG = IPT2.NUM(1,NLCF)
  426. NGCED = IPT2.NUM(3,NLCF)
  427. NGCF = IPT2.NUM(2,NLCF)
  428. NLCF1 = MLENT2.LECT(NGCF)
  429. NLCEG = MLENT1.LECT(NGCEG)
  430. NLCED = MLENT1.LECT(NGCED)
  431. NLFL = MLELIM.LECT(NGCF)
  432. C
  433. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  434. C
  435. IF(NLCF .NE. NLCF1)THEN
  436. MESERR = 'Il ne faut pas jouer avec la console. '
  437. LOGAN = .TRUE.
  438. GOTO 9999
  439. ENDIF
  440. IF(NLFL .EQ. 0)THEN
  441. C
  442. C******* Recuperation des Etats "gauche" et "droite"
  443. C
  444. ROG = MELRO.VELCHE(1,NLCF)
  445. UNG = MELVUN.VELCHE(1,NLCF)
  446. UTG = MELVUT.VELCHE(1,NLCF)
  447. UVG = MELVUV.VELCHE(1,NLCF)
  448. PG = MELP.VELCHE(1,NLCF)
  449. C
  450. ROD = MELRO.VELCHE(3,NLCF)
  451. UND = MELVUN.VELCHE(3,NLCF)
  452. UTD = MELVUT.VELCHE(3,NLCF)
  453. UVD = MELVUV.VELCHE(3,NLCF)
  454. PD = MELP.VELCHE(3,NLCF)
  455. C
  456. CNX = MELVNX.VELCHE(1,NLCF)
  457. CNY = MELVNY.VELCHE(1,NLCF)
  458. CNZ = MELVNZ.VELCHE(1,NLCF)
  459. CTX = MELT1X.VELCHE(1,NLCF)
  460. CTY = MELT1Y.VELCHE(1,NLCF)
  461. CTZ = MELT1Z.VELCHE(1,NLCF)
  462. CVX = MELT2X.VELCHE(1,NLCF)
  463. CVY = MELT2Y.VELCHE(1,NLCF)
  464. CVZ = MELT2Z.VELCHE(1,NLCF)
  465. C
  466. C******* Le fractiones massiques, R et ACVTO
  467. C
  468. RTOTG = 0.0D0
  469. RTOTD = 0.0D0
  470. CVTOTG = 0.0D0
  471. CVTOTD = 0.0D0
  472. Y1G = 1.0D0
  473. Y1D = 1.0D0
  474. ETHERG = 0.0D0
  475. ETHERD = 0.0D0
  476. DO I1= 1, NORDP1, 1
  477. PROPHY.ACVTOG(I1) =0.0D0
  478. PROPHY.ACVTOD(I1) =0.0D0
  479. ENDDO
  480. DO I1 = 1, NESP, 1
  481. MELVA1 = MCHAMY.IELVAL(I1)
  482. YG = MELVA1.VELCHE(1,NLCF)
  483. YD = MELVA1.VELCHE(3,NLCF)
  484. Y1G = Y1G - YG
  485. Y1D = Y1D - YD
  486. FRAMAG.YET(I1) = YG
  487. FRAMAD.YET(I1) = YD
  488. RTOTG = RTOTG + YG * PROPHY.R(I1)
  489. RTOTD = RTOTD + YD * PROPHY.R(I1)
  490. DO I2 = 1, NORDP1
  491. PROPHY.ACVTOG(I2) = PROPHY.ACVTOG(I2) +
  492. & YG * PROPHY.ACV(I2,I1)
  493. PROPHY.ACVTOD(I2) = PROPHY.ACVTOD(I2) +
  494. & YD * PROPHY.ACV(I2,I1)
  495. ENDDO
  496. ENDDO
  497. RTOTG = RTOTG + Y1G * PROPHY.R(NESP+1)
  498. RTOTD = RTOTD + Y1D * PROPHY.R(NESP+1)
  499. DO I2 = 1, NORDP1, 1
  500. PROPHY.ACVTOG(I2) = PROPHY.ACVTOG(I2) +
  501. & Y1G * PROPHY.ACV(I2,NESP+1)
  502. PROPHY.ACVTOD(I2) = PROPHY.ACVTOD(I2) +
  503. & Y1D * PROPHY.ACV(I2,NESP+1)
  504. ENDDO
  505. TG = PG / (ROG * RTOTG)
  506. TD = PD / (ROD * RTOTD)
  507. FUNTG = 1.0D0
  508. FUNTD = 1.0D0
  509. CVTOTG = PROPHY.ACVTOG(1)
  510. ETHERG = CVTOTG * TG
  511. CVTOTD = PROPHY.ACVTOD(1)
  512. ETHERD = CVTOTD * TD
  513. DO I1 = 2, NORDP1, 1
  514. FUNTG = FUNTG * TG
  515. FUNTD = FUNTD * TD
  516. DCV = PROPHY.ACVTOG(I1) * FUNTG
  517. CVTOTG = CVTOTG + DCV
  518. ETHERG = ETHERG + DCV * TG / I1
  519. DCV = PROPHY.ACVTOD(I1) * FUNTD
  520. CVTOTD = CVTOTD + DCV
  521. ETHERD = ETHERD + DCV * TD / I1
  522. ENDDO
  523. GAMG = (CVTOTG + RTOTG) /CVTOTG
  524. GAMD = (CVTOTD + RTOTD) /CVTOTD
  525. C
  526. C******* Les scalaires passifs
  527. C
  528. DO I1 = 1, NSCA, 1
  529. MELVA1 = MCHAMS.IELVAL(I1)
  530. SCAG.YET(I1) = MELVA1.VELCHE(1,NLCF)
  531. SCAD.YET(I1) = MELVA1.VELCHE(3,NLCF)
  532. ENDDO
  533. C
  534. C******* On a defini (ROg,ROUNg,ROUTg,Pg,(Yg)), (ROd,ROUNd,ROUTd,Pd,(Yd))
  535. C et on a déjà verifié ROg, ROd, Pg, Pd > 0 et 0<Y_i<1
  536. C
  537. C
  538. C******* Calcul du flux aux interfaces
  539. C
  540. IF(INDMET .EQ. 1)THEN
  541. C
  542. C********** VLH FVS
  543. C
  544. CALL FVLHT2(NESP,NSCA,
  545. & GAMG,ROG,PG,UNG,UTG,UVG,ETHERG,
  546. & GAMD,ROD,PD,UND,UTD,UVD,ETHERD,
  547. & FRAMAG.YET,FRAMAD.YET,
  548. & SCAG.YET,SCAD.YET,
  549. & IFLU1.FLUX,IFLU2.FLUX,
  550. & CELLT)
  551. ELSEIF(INDMET .EQ. 2)THEN
  552. C
  553. C******* Colella-Glaz FDS (avec Entropy-fix)
  554. C
  555. XST=0.0D0
  556. CALL FCOLT2(NESP,NSCA,NORDP1,XST,
  557. & GAMG,RTOTG,PROPHY.ACVTOG,ROG,PG,TG,UNG,UTG,UVG,ETHERG,
  558. & GAMD,RTOTD,PROPHY.ACVTOD,ROD,PD,TD,UND,UTD,UVD,ETHERD,
  559. & FRAMAG.YET,FRAMAD.YET,
  560. & SCAG.YET,SCAD.YET,
  561. & IFLU1.FLUX,CELLT,
  562. & LOGNC,MESERR,LOGAN)
  563. ENDIF
  564. C
  565. IF(LOGAN) GOTO 9999
  566. IF(LOGNC) GOTO 9999
  567. C
  568. C******* Ecriture des flux
  569. C
  570. C FLUX(1) = RO Un RO Un
  571. C FLUX(2) = RO Un Un + P -> RO Un Ux + P CNX
  572. C FLUX(3) = RO Un Ut -> RO Un Uy + P CNY
  573. C FLUX(4) = RO Un Et RO Un Et
  574. C
  575. SURF = MPOVSU.VPOCHA(NLCF,1)
  576. MPOFLU.VPOCHA(NLCF,1) =
  577. & (IFLU1.FLUX(1) * SURF )
  578. MPOFLU.VPOCHA(NLCF,2) =
  579. &((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX+IFLU1.FLUX(4)*CVX) * SURF)
  580. MPOFLU.VPOCHA(NLCF,3) =
  581. &((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY+IFLU1.FLUX(4)*CVY) * SURF)
  582. MPOFLU.VPOCHA(NLCF,4) =
  583. &((IFLU1.FLUX(2)*CNZ+IFLU1.FLUX(3)*CTZ+IFLU1.FLUX(4)*CVZ) * SURF)
  584. MPOFLU.VPOCHA(NLCF,5) =
  585. & (IFLU1.FLUX(5) * SURF)
  586. DO I1 = 1, NESP, 1
  587. MPOFLU.VPOCHA(NLCF,5+I1)=IFLU1.FLUX(5+I1)
  588. & * SURF
  589. ENDDO
  590. DO I1 = 1, NSCA, 1
  591. MPOFLU.VPOCHA(NLCF,5+NESP+I1)=IFLU1.FLUX(5+I1+NESP)
  592. & * SURF
  593. ENDDO
  594. C
  595. C******* Calcul du pas du temps (CFL)
  596. C
  597. C****** a) etat a l'interface
  598. C
  599. DIAMG = MPOVDI.VPOCHA(NLCEG,1)
  600. DIAMD = MPOVDI.VPOCHA(NLCED,1)
  601. DIAM = MIN(DIAMG,DIAMD)
  602. CELL = 1.0D0/DIAM/CELLT
  603. IF(CELL .GT. UNSDT)THEN
  604. UNSDT = CELL
  605. ENDIF
  606. C
  607. C****** b) etat gauche
  608. C
  609. ASON = SQRT(GAMG*PG/ROG)
  610. LAMBDA = ABS(UNG) + ASON
  611. CELL = LAMBDA / DIAM
  612. IF(CELL .GT. UNSDT)THEN
  613. UNSDT = CELL
  614. ENDIF
  615. C
  616. C****** C) etat droite
  617. C
  618. ASON = SQRT(GAMD*PD/ROD)
  619. LAMBDA = ABS(UND) + ASON
  620. CELL = LAMBDA / DIAM
  621. IF(CELL .GT. UNSDT)THEN
  622. UNSDT = CELL
  623. ENDIF
  624. ENDIF
  625. C
  626. C
  627. C**** Fin boucle sur FACEL
  628. C
  629. ENDDO
  630. C
  631. C**** Pas du temps (condition de non interaction en 1D)
  632. C
  633. DT = 0.5D0 / UNSDT
  634. C
  635. C**** Desactivation des segments et
  636. C on detruit les MCHAMLs
  637. C
  638. C
  639. C**** SEGSUP FRAMAG
  640. C SEGSUP FRAMAD
  641. C
  642. C meme si LOGME = .FALSE.
  643. C
  644. SEGSUP FRAMAG
  645. SEGSUP FRAMAD
  646. C
  647. SEGSUP MLENT1
  648. SEGDES MLENT2
  649. SEGDES IPT2
  650. C
  651. SEGSUP IFLU1
  652. SEGSUP IFLU2
  653. C
  654. SEGDES MPOVSU
  655. SEGDES MPOVDI
  656. C
  657. SEGDES MPOFLU
  658. C
  659. SEGDES MELRO
  660. SEGDES MELP
  661. SEGDES MELVUN
  662. SEGDES MELVUT
  663. SEGDES MELVNX
  664. SEGDES MELVNY
  665. SEGDES MELT1X
  666. SEGDES MELT1Y
  667. c SEGDES MELLIM
  668. SEGDES MLELIM
  669. C
  670. IF(LOGME) THEN
  671. DO I1 = 1, NESP
  672. MELVA1 = MCHAMY.IELVAL(I1)
  673. SEGDES MELVA1
  674. ENDDO
  675. C
  676. SEGDES MCHAMY
  677. ENDIF
  678. IF(ISCAF .GT. 0) THEN
  679. DO I1 = 1, NSCA, 1
  680. MELVA1 = MCHAMS.IELVAL(I1)
  681. SEGDES MELVA1
  682. ENDDO
  683. C
  684. SEGDES MCHAMS
  685. ENDIF
  686. C
  687. 9999 CONTINUE
  688. C
  689. RETURN
  690. END
  691. C
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  

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