Télécharger ckon1.eso

Retour à la liste

Numérotation des lignes :

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

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