Télécharger ckon3.eso

Retour à la liste

Numérotation des lignes :

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

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