Télécharger konfl2.eso

Retour à la liste

Numérotation des lignes :

konfl2
  1. C KONFL2 SOURCE CB215821 20/11/25 13:32:03 10792
  2. SUBROUTINE KONFL2(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 : CKON3
  13. C
  14. C DESCRIPTION : Voir CKON
  15. C
  16. C Cas deux 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) : FVLHTE, FCOLTE
  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 passifs
  42. C .FALSE. -> no scalaires passifs
  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 (il faudrait dire E/S)
  90. C
  91. C ICHFLU : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
  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 n'a pas bien
  101. C marchéee
  102. C
  103. C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
  104. C
  105. C MESERR : pour l'ecriture des messages d'erreurs
  106. C
  107. C************************************************************************
  108. C
  109. C HISTORIQUE (Anomalies et modifications éventuelles)
  110. C
  111. C HISTORIQUE : 22.12.98 Creation
  112. C
  113. C 08.02.00 Ajout du flux numerique de Colella-Glaz
  114. C
  115. C 21.02.00 Ajout de transport de scalaires passifs
  116. C
  117. C 03.12.03 Ajout le MAILLIM comme le l'entree
  118. C
  119. C************************************************************************
  120. C
  121. C
  122. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  123. C GAMMA \in (1,3)
  124. C Y \in (0,1)
  125. C Si non il faut le faire!!!
  126. C
  127. C************************************************************************
  128. C
  129. C
  130. C**** Variables de COOPTIO
  131. C
  132. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  133. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  134. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  135. C & ,IECHO, IIMPI, IOSPI
  136. C & ,IDIM
  137. CC & ,MCOORD
  138. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  139. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  140. C & ,NORINC,NORVAL,NORIND,NORVAD
  141. C & ,NUCROU, IPSAUV
  142. C
  143. IMPLICIT INTEGER(I-N)
  144. INTEGER I1, I2
  145. & ,INDMET, NORDP1
  146. & ,IROF,IVITF,IPF,ISCAF,IFRMAF
  147. & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
  148. & ,IGEOMC,IGEOMF
  149. & ,ICHFLU
  150. & ,NESP, NFAC, NSCA, NMA, NMA2
  151. & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
  152. & ,NGCF, NLCF1, SPG1, SPG2, NLFL
  153. REAL*8 DT, UNSDT, CELLT
  154. & , ROG, UNG, UTG, PG, GAMG, TG
  155. & , ROD, UND, UTD, PD, GAMD, TD
  156. & , SURF,CNX, CNY, CTX , CTY
  157. & , CELL, DIAMG, DIAMD, DIAM
  158. & , ASON, LAMBDA
  159. & , Y1G, Y1D, RTOTG, RTOTD, CVTOTG, CVTOTD, ETHERG, ETHERD
  160. & , YG, YD, FUNTG, FUNTD, DCV, XST
  161. LOGICAL LOGME, LOGSCA, LOGNC, LOGAN
  162. CHARACTER*(40) MESERR
  163. CHARACTER*(8) TYPE
  164. C
  165. C**** Segment des proprietes du gaz
  166. C
  167. SEGMENT PROPHY
  168. REAL*8 ACV(NORDP1,NESP+1), R(NESP+1), H0K(NESP+1)
  169. & ,ACVTOG(NORDP1), ACVTOD(NORDP1)
  170. ENDSEGMENT
  171. C
  172. C**** Les Includes
  173. C
  174. C
  175. C**** LES INCLUDES
  176. C
  177.  
  178. -INC PPARAM
  179. -INC CCOPTIO
  180. -INC SMCOORD
  181. -INC SMCHAML
  182. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  183. & MELT1X.MELVAL, MELT1Y.MELVAL
  184. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  185. POINTEUR MELRO.MELVAL, MELP.MELVAL
  186. -INC SMCHPOI
  187. POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  188. & , MPOFLU.MPOVAL
  189. POINTEUR MCHAMY.MCHAML, MCHAMS.MCHAML
  190. -INC SMELEME
  191. POINTEUR MELLIM.MELEME
  192. -INC SMLMOTS
  193. -INC SMLENTI
  194. POINTEUR MLELIM.MLENTI
  195. C
  196. C**** Les fractiones massiques.
  197. C
  198. SEGMENT FRAMAS
  199. REAL*8 YET(NMA)
  200. ENDSEGMENT
  201. POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS, SCAG.FRAMAS, SCAD.FRAMAS
  202. C
  203. C**** Les flux aux interface dans le repaire (n,t)
  204. C
  205. SEGMENT IFLUX
  206. REAL*8 FLUX(NMA2)
  207. ENDSEGMENT
  208. POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
  209. C
  210. C**** KRIPAD pour la correspondance global/local des conditions limits
  211. C
  212. CALL KRIPAD(MELLIM,MLELIM)
  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. MELT1X = MCHAM1.IELVAL(3)
  263. MELT1Y = MCHAM1.IELVAL(4)
  264. SEGDES MCHAM1
  265. SEGACT MCHAM2
  266. MELVUN = MCHAM2.IELVAL(1)
  267. MELVUT = MCHAM2.IELVAL(2)
  268. SEGDES MCHAM2
  269. SEGDES MCHEL1
  270. C
  271. C**** Fractions massiques
  272. C
  273. IF(LOGME)THEN
  274. MCHEL1 = IFRMAF
  275. SEGACT MCHEL1
  276. MCHAMY = MCHEL1.ICHAML(1)
  277. SEGACT MCHAMY
  278. C
  279. C******* Numero d'especes dans les equations d'Euler
  280. C
  281. NESP = MCHAMY.IELVAL(/1)
  282. DO I1 = 1, NESP
  283. MELVA1 = MCHAMY.IELVAL(I1)
  284. SEGACT MELVA1
  285. ENDDO
  286. NMA = NESP
  287. SEGINI FRAMAG
  288. SEGINI FRAMAD
  289. SEGDES MCHEL1
  290. ELSE
  291. C
  292. C******* Definition minimale de YET, necessaire pour transmetre YET aux
  293. C subroutines FORTRAN qui calculent les flux
  294. C
  295. NMA = 1
  296. SEGINI FRAMAG
  297. SEGINI FRAMAD
  298. NESP = 0
  299. ENDIF
  300. C
  301. C**** Scalaires passifs
  302. C
  303. IF(LOGSCA)THEN
  304. MCHEL1 = ISCAF
  305. SEGACT MCHEL1
  306. MCHAMS = MCHEL1.ICHAML(1)
  307. SEGACT MCHAMS
  308. NSCA = MCHAMS.IELVAL(/1)
  309. DO I1 = 1, NSCA, 1
  310. MELVA1 = MCHAMS.IELVAL(I1)
  311. SEGACT MELVA1
  312. ENDDO
  313. NMA = NSCA
  314. SEGINI SCAG
  315. SEGINI SCAD
  316. SEGDES MCHEL1
  317. ELSE
  318. C
  319. C******* Definition minimale de YET, necessaire pour transmetre YET aux
  320. C subroutines FORTRAN qui calculent les flux
  321. C
  322. NMA = 1
  323. SEGINI SCAG
  324. SEGINI SCAD
  325. NSCA= 0
  326. ENDIF
  327. C
  328. C**** Initialisation des MELEMEs
  329. C
  330. C 'CENTRE', 'FACEL'
  331. C
  332. IPT2 = MELEFE
  333. SEGACT IPT2
  334. NFAC = IPT2.NUM(/2)
  335. C
  336. C**** KRIPAD pour la correspondance global/local de centre
  337. C
  338. CALL KRIPAD(MELEMC,MLENT1)
  339. C
  340. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  341. C
  342. C Si i est le numero global d'un noeud de ICEN,
  343. C MLENT1.LECT(i) contient sa position, i.e.
  344. C
  345. C I = numero global du noeud centre
  346. C MLENT1.LECT(i) = numero local du noeud centre
  347. C
  348. C MLENT1 déjà activé, i.e.
  349. C
  350. C SEGACT MLENT1
  351. C
  352. C
  353. C**** KRIPAD pour la correspondance global/local de 'FACE'
  354. C
  355. CALL KRIPAD(MELEMF,MLENT2)
  356. C
  357. C**** Initialisation de flux
  358. C
  359. NMA2 = 4 + NESP + NSCA
  360. SEGINI IFLU1
  361. SEGINI IFLU2
  362. C
  363. C**** IFLU2 = segment de travail en FLUVLH; c'est plus rapide le definir ici
  364. C
  365. C
  366. C**** CHPOINTs de la table DOMAINE
  367. C
  368. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  369. CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
  370. C
  371. C**** LICHT active les MPOVALs en *MOD
  372. C
  373. C i.e.
  374. C
  375. C SEGACT MPOVSU*MOD
  376. C SEGACT MPOVDI*MOD
  377. C
  378. C
  379. C**** Les FLUX aux face
  380. C
  381. C La densité
  382. C
  383. CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
  384. C
  385. C SEGACT MPOFLU*MOD
  386. C
  387. C**** Activation des MCHAMLs
  388. C
  389. SEGACT MELRO
  390. SEGACT MELP
  391. SEGACT MELVUN
  392. SEGACT MELVUT
  393. SEGACT MELVNX
  394. SEGACT MELVNY
  395. SEGACT MELT1X
  396. SEGACT MELT1Y
  397. C
  398. C**** Initialisation de 1/DT
  399. C
  400. UNSDT = 0.0D0
  401. C
  402. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  403. C
  404. DO NLCF = 1, NFAC
  405. C
  406. C******* NLCF = numero local du centre de facel
  407. C NGCF = numero global du centre de facel
  408. C NLCF1 = numero local du centre de face
  409. C NGCEG = numero global du centre ELT "gauche"
  410. C NLCEG = numero local du centre ELT "gauche"
  411. C NGCED = numero global du centre ELT "droite"
  412. C NLCED = numero local du centre ELT "droite"
  413. C
  414. NGCEG = IPT2.NUM(1,NLCF)
  415. NGCED = IPT2.NUM(3,NLCF)
  416. NGCF = IPT2.NUM(2,NLCF)
  417. NLCF1 = MLENT2.LECT(NGCF)
  418. NLCEG = MLENT1.LECT(NGCEG)
  419. NLCED = MLENT1.LECT(NGCED)
  420. NLFL = MLELIM.LECT(NGCF)
  421. C
  422. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  423. C
  424. IF(NLCF .NE. NLCF1)THEN
  425. MESERR = 'Il ne faut pas jouer avec la console. '
  426. LOGAN = .TRUE.
  427. GOTO 9999
  428. ENDIF
  429. IF(NLFL .EQ. 0)THEN
  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. PG = MELP.VELCHE(1,NLCF)
  437. C
  438. ROD = MELRO.VELCHE(3,NLCF)
  439. UND = MELVUN.VELCHE(3,NLCF)
  440. UTD = MELVUT.VELCHE(3,NLCF)
  441. PD = MELP.VELCHE(3,NLCF)
  442. C
  443. CNX = MELVNX.VELCHE(1,NLCF)
  444. CNY = MELVNY.VELCHE(1,NLCF)
  445. CTX = MELT1X.VELCHE(1,NLCF)
  446. CTY = MELT1Y.VELCHE(1,NLCF)
  447. C
  448. C******* Le fractiones massiques, R et ACVTO
  449. C
  450. RTOTG = 0.0D0
  451. RTOTD = 0.0D0
  452. CVTOTG = 0.0D0
  453. CVTOTD = 0.0D0
  454. Y1G = 1.0D0
  455. Y1D = 1.0D0
  456. ETHERG = 0.0D0
  457. ETHERD = 0.0D0
  458. DO I1= 1, NORDP1, 1
  459. PROPHY.ACVTOG(I1) =0.0D0
  460. PROPHY.ACVTOD(I1) =0.0D0
  461. ENDDO
  462. DO I1 = 1, NESP, 1
  463. MELVA1 = MCHAMY.IELVAL(I1)
  464. YG = MELVA1.VELCHE(1,NLCF)
  465. YD = MELVA1.VELCHE(3,NLCF)
  466. Y1G = Y1G - YG
  467. Y1D = Y1D - YD
  468. FRAMAG.YET(I1) = YG
  469. FRAMAD.YET(I1) = YD
  470. RTOTG = RTOTG + YG * PROPHY.R(I1)
  471. RTOTD = RTOTD + YD * PROPHY.R(I1)
  472. DO I2 = 1, NORDP1
  473. PROPHY.ACVTOG(I2) = PROPHY.ACVTOG(I2) +
  474. & YG * PROPHY.ACV(I2,I1)
  475. PROPHY.ACVTOD(I2) = PROPHY.ACVTOD(I2) +
  476. & YD * PROPHY.ACV(I2,I1)
  477. ENDDO
  478. ENDDO
  479. RTOTG = RTOTG + Y1G * PROPHY.R(NESP+1)
  480. RTOTD = RTOTD + Y1D * PROPHY.R(NESP+1)
  481. DO I2 = 1, NORDP1, 1
  482. PROPHY.ACVTOG(I2) = PROPHY.ACVTOG(I2) +
  483. & Y1G * PROPHY.ACV(I2,NESP+1)
  484. PROPHY.ACVTOD(I2) = PROPHY.ACVTOD(I2) +
  485. & Y1D * PROPHY.ACV(I2,NESP+1)
  486. ENDDO
  487. TG = PG / (ROG * RTOTG)
  488. TD = PD / (ROD * RTOTD)
  489. FUNTG = 1.0D0
  490. FUNTD = 1.0D0
  491. CVTOTG = PROPHY.ACVTOG(1)
  492. ETHERG = CVTOTG * TG
  493. CVTOTD = PROPHY.ACVTOD(1)
  494. ETHERD = CVTOTD * TD
  495. DO I1 = 2, NORDP1, 1
  496. FUNTG = FUNTG * TG
  497. FUNTD = FUNTD * TD
  498. DCV = PROPHY.ACVTOG(I1) * FUNTG
  499. CVTOTG = CVTOTG + DCV
  500. ETHERG = ETHERG + DCV * TG / I1
  501. DCV = PROPHY.ACVTOD(I1) * FUNTD
  502. CVTOTD = CVTOTD + DCV
  503. ETHERD = ETHERD + DCV * TD / I1
  504. ENDDO
  505. GAMG = (CVTOTG + RTOTG) /CVTOTG
  506. GAMD = (CVTOTD + RTOTD) /CVTOTD
  507. C
  508. C******* Les scalaires passifs
  509. C
  510. DO I1 = 1, NSCA, 1
  511. MELVA1 = MCHAMS.IELVAL(I1)
  512. SCAG.YET(I1) = MELVA1.VELCHE(1,NLCF)
  513. SCAD.YET(I1) = MELVA1.VELCHE(3,NLCF)
  514. ENDDO
  515. C
  516. C******* On a defini (ROg,ROUNg,ROUTg,Pg,(Yg)), (ROd,ROUNd,ROUTd,Pd,(Yd))
  517. C et on a déjà verifié ROg, ROd, Pg, Pd > 0 et 0<Y_i<1
  518. C
  519. C
  520. C******* Calcul du flux aux interfaces
  521. C
  522. IF(INDMET .EQ. 1)THEN
  523. C
  524. C********** VLH FVS
  525. C
  526. CALL FVLHTE(NESP,NSCA,
  527. & GAMG,ROG,PG,UNG,UTG,ETHERG,
  528. & GAMD,ROD,PD,UND,UTD,ETHERD,
  529. & FRAMAG.YET,FRAMAD.YET,
  530. & SCAG.YET,SCAD.YET,
  531. & IFLU1.FLUX,IFLU2.FLUX,
  532. & CELLT)
  533. ELSEIF(INDMET .EQ. 2)THEN
  534. C
  535. C******* Colella-Glaz FDS (avec Entropy-fix)
  536. C
  537. XST=0.0D0
  538. CALL FCOLTE(NESP,NSCA,NORDP1,XST,
  539. & GAMG,RTOTG,PROPHY.ACVTOG,ROG,PG,TG,UNG,UTG,ETHERG,
  540. & GAMD,RTOTD,PROPHY.ACVTOD,ROD,PD,TD,UND,UTD,ETHERD,
  541. & FRAMAG.YET,FRAMAD.YET,
  542. & SCAG.YET,SCAD.YET,
  543. & IFLU1.FLUX,CELLT,
  544. & LOGNC,MESERR,LOGAN)
  545. ENDIF
  546. C
  547. IF(LOGAN) GOTO 9999
  548. IF(LOGNC) GOTO 9999
  549. C
  550. C******* Ecriture des flux
  551. C
  552. C FLUX(1) = RO Un RO Un
  553. C FLUX(2) = RO Un Un + P -> RO Un Ux + P CNX
  554. C FLUX(3) = RO Un Ut -> RO Un Uy + P CNY
  555. C FLUX(4) = RO Un Et RO Un Et
  556. C
  557. SURF = MPOVSU.VPOCHA(NLCF,1)
  558. MPOFLU.VPOCHA(NLCF,1) =
  559. & (IFLU1.FLUX(1) * SURF )
  560. MPOFLU.VPOCHA(NLCF,2) =
  561. & ((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX) * SURF)
  562. MPOFLU.VPOCHA(NLCF,3) =
  563. & ((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY) * SURF)
  564. MPOFLU.VPOCHA(NLCF,4) =
  565. & (IFLU1.FLUX(4) * SURF)
  566. DO I1 = 1, NESP, 1
  567. MPOFLU.VPOCHA(NLCF,4+I1)=IFLU1.FLUX(4+I1)
  568. & * SURF
  569. ENDDO
  570. DO I1 = 1, NSCA, 1
  571. MPOFLU.VPOCHA(NLCF,4+NESP+I1)=IFLU1.FLUX(4+I1+NESP)
  572. & * SURF
  573. ENDDO
  574. C
  575. C******* Calcul du pas du temps (CFL)
  576. C
  577. C****** a) etat a l'interface
  578. C
  579. DIAMG = MPOVDI.VPOCHA(NLCEG,1)
  580. DIAMD = MPOVDI.VPOCHA(NLCED,1)
  581. DIAM = MIN(DIAMG,DIAMD)
  582. CELL = 1.0D0/DIAM/CELLT
  583. IF(CELL .GT. UNSDT)THEN
  584. UNSDT = CELL
  585. ENDIF
  586. C
  587. C****** b) etat gauche
  588. C
  589. ASON = SQRT(GAMG*PG/ROG)
  590. LAMBDA = ABS(UNG) + ASON
  591. CELL = LAMBDA / DIAM
  592. IF(CELL .GT. UNSDT)THEN
  593. UNSDT = CELL
  594. ENDIF
  595. C
  596. C****** C) etat droite
  597. C
  598. ASON = SQRT(GAMD*PD/ROD)
  599. LAMBDA = ABS(UND) + ASON
  600. CELL = LAMBDA / DIAM
  601. IF(CELL .GT. UNSDT)THEN
  602. UNSDT = CELL
  603. ENDIF
  604. ENDIF
  605. C
  606. C**** Fin boucle sur FACEL
  607. C
  608. ENDDO
  609. C
  610. C**** Pas du temps (condition de non interaction en 1D)
  611. C
  612. DT = 0.5D0 / UNSDT
  613. C
  614. C**** Desactivation des segments et
  615. C on detruit les MCHAMLs
  616. C
  617. C
  618. C**** SEGSUP FRAMAG
  619. C SEGSUP FRAMAD
  620. C
  621. C meme si LOGME = .FALSE.
  622. C
  623. SEGDES FRAMAG
  624. SEGDES FRAMAD
  625. C
  626. SEGDES MLENT1
  627. SEGDES MLENT2
  628. SEGDES IPT2
  629. C
  630. SEGDES IFLU1
  631. SEGDES IFLU2
  632. C
  633. SEGDES MPOVSU
  634. SEGDES MPOVDI
  635. C
  636. SEGDES MPOFLU
  637. C
  638. SEGDES MELRO
  639. SEGDES MELP
  640. SEGDES MELVUN
  641. SEGDES MELVUT
  642. SEGDES MELVNX
  643. SEGDES MELVNY
  644. SEGDES MELT1X
  645. SEGDES MELT1Y
  646. c SEGDES MELLIM
  647. SEGDES MLELIM
  648. C
  649. IF(LOGME) THEN
  650. DO I1 = 1, NESP
  651. MELVA1 = MCHAMY.IELVAL(I1)
  652. SEGDES MELVA1
  653. ENDDO
  654. C
  655. SEGDES MCHAMY
  656. ENDIF
  657. IF(LOGSCA) THEN
  658. DO I1 = 1, NSCA, 1
  659. MELVA1 = MCHAMS.IELVAL(I1)
  660. SEGDES MELVA1
  661. ENDDO
  662. C
  663. SEGDES MCHAMS
  664. ENDIF
  665. C
  666. 9999 CONTINUE
  667. C
  668. RETURN
  669. END
  670. C
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682.  
  683.  
  684.  
  685.  
  686.  
  687.  
  688.  

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