Télécharger ckon2.eso

Retour à la liste

Numérotation des lignes :

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

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