Télécharger la plaquette Cast3M


fr en

Télécharger ckon1.eso

Retour à la liste

Numérotation des lignes : 

ckon1

  1. C CKON1     SOURCE    CB215821  20/11/25    13:19:46     10792          
  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.  
  174. -INC PPARAM
  175. -INC CCOPTIO
  176. -INC SMCOORD
  177. -INC SMCHAML
  178.       POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  179.      &         MELT1X.MELVAL, MELT1Y.MELVAL
  180.       POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  181.       POINTEUR MELRO.MELVAL, MELP.MELVAL,
  182.      &         MELGAM.MELVAL
  183. -INC SMCHPOI
  184.       POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  185.      &        , MPOVG1.MPOVAL, MPOVG2.MPOVAL
  186.      &        , MPOVG3.MPOVAL, MPOVG4.MPOVAL
  187.       POINTEUR MCHAMY.MCHAML
  188. -INC SMELEME
  189. -INC SMLMOTS
  190. -INC SMLENTI
  191. C
  192. C**** Les fractiones massiques.
  193. C
  194.       SEGMENT FRAMAS
  195.          REAL*8 YET(NESP)
  196.       ENDSEGMENT
  197.       POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS
  198. C
  199. C**** Les flux aux interface dans le repaire (n,t)
  200. C
  201.       SEGMENT IFLUX
  202.          REAL*8 FLUX(NESP+4)
  203.       ENDSEGMENT
  204.       POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
  205. C
  206. C
  207. C**** Initialisation des MCHAMLs
  208. C
  209. C**** Masse volumique
  210. C
  211.       MCHEL1 = IROF
  212.       SEGACT MCHEL1
  213.       MCHAM1 = MCHEL1.ICHAML(1)
  214.       SEGACT MCHAM1
  215.       MELRO = MCHAM1.IELVAL(1)
  216.       SEGDES MCHEL1
  217.       SEGDES MCHAM1
  218. C
  219. C**** Pression
  220. C
  221.       MCHEL1 = IPF
  222.       SEGACT MCHEL1
  223.       MCHAM1 = MCHEL1.ICHAML(1)
  224.       SEGACT MCHAM1
  225.       MELP = MCHAM1.IELVAL(1)
  226.       SEGDES MCHEL1
  227.       SEGDES MCHAM1
  228. C
  229. C**** Gamma
  230. C
  231.       MCHEL1 = IGAMF
  232.       SEGACT MCHEL1
  233.       MCHAM1 = MCHEL1.ICHAML(1)
  234.       SEGACT MCHAM1
  235.       MELGAM = MCHAM1.IELVAL(1)
  236.       SEGDES MCHEL1
  237.       SEGDES MCHAM1
  238. C
  239. C**** Vitesse et cosinus directeurs du repere (n,t)
  240. C
  241.       MCHEL1 = IVITF
  242.       SEGACT MCHEL1
  243. C
  244. C**** La vitesse a comme SPG MELEFE
  245. C     Le cosinus directeurs ont comme SPG MELEMF
  246. C
  247. C     MCHAM1 -> Cosinus directeurs
  248. C     MCHAM2 -> Vitesse
  249. C
  250.       SPG1 = MCHEL1.IMACHE(1)
  251.       SPG2 = MCHEL1.IMACHE(2)
  252.       IF((SPG1 .EQ. MELEMF)  .AND. (SPG2 .EQ. MELEFE))THEN
  253.          MCHAM1 = MCHEL1.ICHAML(1)
  254.          MCHAM2 = MCHEL1.ICHAML(2)
  255.       ELSEIF((SPG1 .EQ. MELEFE)  .AND. (SPG2 .EQ. MELEMF))THEN
  256.          MCHAM1 = MCHEL1.ICHAML(2)
  257.          MCHAM2 = MCHEL1.ICHAML(1)
  258.       ELSE
  259.          LOGAN = .TRUE.
  260.          GOTO 9999
  261.       ENDIF
  262.       SEGACT MCHAM1
  263.       MELVNX = MCHAM1.IELVAL(1)
  264.       MELVNY = MCHAM1.IELVAL(2)
  265.       MELT1X = MCHAM1.IELVAL(3)
  266.       MELT1Y = MCHAM1.IELVAL(4)
  267.       SEGDES MCHAM1
  268.       SEGACT MCHAM2
  269.       MELVUN = MCHAM2.IELVAL(1)
  270.       MELVUT = MCHAM2.IELVAL(2)
  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 MELVNX
  390.       SEGACT MELVNY
  391.       SEGACT MELT1X
  392.       SEGACT MELT1Y
  393. C
  394. C**** Initialisation de 1/DT
  395. C
  396.       UNSDT = 0.0D0
  397. C
  398. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  399. C
  400.       DO NLCF = 1, NFAC
  401. C
  402. C******* NLCF  = numero local du centre de facel
  403. C        NGCF  = numero global du centre de facel
  404. C        NLCF1 = numero local du centre de face
  405. C        NGCEG = numero global du centre ELT "gauche"
  406. C        NLCEG = numero local du centre ELT "gauche"
  407. C        NGCED = numero global du centre ELT "droite"
  408. C        NLCED = numero local du centre ELT "droite"
  409. C
  410.          NGCEG = IPT2.NUM(1,NLCF)
  411.          NGCED = IPT2.NUM(3,NLCF)
  412.          NGCF  = IPT2.NUM(2,NLCF)
  413.          NLCF1 = MLENT2.LECT(NGCF)
  414.          NLCEG = MLENT1.LECT(NGCEG)
  415.          NLCED = MLENT1.LECT(NGCED)
  416. C
  417. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  418. C
  419.          IF(NLCF .NE. NLCF1)THEN
  420.             MESERR = 'Il ne faut pas jouer avec la console.   '
  421.             LOGAN = .TRUE.
  422.             GOTO 9999
  423.          ENDIF
  424. C
  425. C******* Recuperation des Etats "gauche" et "droite"
  426. C
  427.          ROG = MELRO.VELCHE(1,NLCF)
  428.          UNG = MELVUN.VELCHE(1,NLCF)
  429.          UTG = MELVUT.VELCHE(1,NLCF)
  430.          PG = MELP.VELCHE(1,NLCF)
  431.          GAMG = MELGAM.VELCHE(1,NLCF)
  432. C
  433.          ROD = MELRO.VELCHE(3,NLCF)
  434.          UND = MELVUN.VELCHE(3,NLCF)
  435.          UTD = MELVUT.VELCHE(3,NLCF)
  436.          PD = MELP.VELCHE(3,NLCF)
  437.          GAMD = MELGAM.VELCHE(3,NLCF)
  438. C
  439.          CNX = MELVNX.VELCHE(1,NLCF)
  440.          CNY = MELVNY.VELCHE(1,NLCF)
  441.          CTX = MELT1X.VELCHE(1,NLCF)
  442.          CTY = MELT1Y.VELCHE(1,NLCF)
  443. C
  444. C******* Le fractiones massiques
  445. C
  446.          IF(LOGME)THEN
  447.             DO I1 = 1, NESP
  448.                MELVA1 = MCHAMY.IELVAL(I1)
  449.                FRAMAG.YET(I1) = MELVA1.VELCHE(1,NLCF)
  450.                FRAMAD.YET(I1) = MELVA1.VELCHE(3,NLCF)
  451.             ENDDO
  452.          ENDIF
  453. C
  454. C******* On a defini (ROg,ROUNg,ROUTg,Pg,(Yg)), (ROd,ROUNd,ROUTd,Pd,(Yd))
  455. C        et on a déjà verifié ROg, ROd, Pg, Pd > 0 et 0<Y_i<1
  456. C
  457. C
  458. C******* Calcul du flux aux interfaces
  459. C
  460.          IF(INDMET .EQ. 1)THEN
  461. C
  462. C******* GODUNOV
  463. C        FLURIE en FORTRAN STANDARD
  464. C
  465.             CALL FLURIE(NESP,
  466.      &                  GAMG,ROG,PG,UNG,UTG,
  467.      &                  GAMD,ROD,PD,UND,UTD,
  468.      &                  FRAMAG.YET,FRAMAD.YET,
  469.      &                  IFLU1.FLUX,
  470.      &                  CELLT,
  471.      &                  LOGNC,LOGAN,MESERR)
  472. C
  473.          ELSEIF(INDMET .EQ. 2)THEN
  474. C
  475. C******* Van Leer FVS
  476. C
  477. C        N.B: FLUXVL en FORTRAN pure
  478. C             FRAMAG.YET = table d'un pointeur -> table
  479. C             La meme chose pour FRAMAD.YET, IFLU1.FLUX,
  480. C             IFLU2.FLUX
  481. C
  482.             CALL FLUXVL(NESP,
  483.      &                  GAMG,ROG,PG,UNG,UTG,
  484.      &                  GAMD,ROD,PD,UND,UTD,
  485.      &                  FRAMAG.YET,FRAMAD.YET,
  486.      &                  IFLU1.FLUX,IFLU2.FLUX,
  487.      &                  CELLT)
  488.          ELSEIF(INDMET .EQ. 3)THEN
  489. C
  490. C******* Van Leer - Hanel FVS
  491. C
  492. C        N.B: FLUVLH en FORTRAN pure
  493. C             FRAMAG.YET = table d'un pointeur -> table
  494. C             La meme chose pour FRAMAD.YET, IFLU1.FLUX,
  495. C             IFLU2.FLUX
  496. C
  497.             CALL FLUVLH(NESP,
  498.      &                  GAMG,ROG,PG,UNG,UTG,
  499.      &                  GAMD,ROD,PD,UND,UTD,
  500.      &                  FRAMAG.YET,FRAMAD.YET,
  501.      &                  IFLU1.FLUX,IFLU2.FLUX,
  502.      &                  CELLT)
  503.          ELSEIF(INDMET .EQ. 4)THEN
  504. C
  505. C******* HUS (Van Leer FVS + Osher FDS)
  506. C
  507.             CALL FLHUS1(NESP,
  508.      &                  GAMG,ROG,PG,UNG,UTG,
  509.      &                  GAMD,ROD,PD,UND,UTD,
  510.      &                  FRAMAG.YET,FRAMAD.YET,
  511.      &                  IFLU1.FLUX,IFLU2.FLUX,
  512.      &                  CELLT,
  513.      &                  LOGNC,MESERR,LOGAN)
  514.          ELSEIF(INDMET .EQ. 5)THEN
  515. C
  516. C******* HUS (Van Leer - Hanel FVS + Osher FDS)
  517. C
  518.             CALL FLHUS2(NESP,
  519.      &                  GAMG,ROG,PG,UNG,UTG,
  520.      &                  GAMD,ROD,PD,UND,UTD,
  521.      &                  FRAMAG.YET,FRAMAD.YET,
  522.      &                  IFLU1.FLUX,IFLU2.FLUX,
  523.      &                  CELLT,
  524.      &                  LOGNC,MESERR,LOGAN)
  525. C         ELSEIF(INDMET .EQ. 6)THEN
  526. C
  527. C******** AUSM
  528. C
  529. C            CALL FLAUSM(NESP,
  530. C     &                  GAMG,ROG,PG,UNG,UTG,
  531. C     &                  GAMD,ROD,PD,UND,UTD,
  532. C     &                  FRAMAG.YET,FRAMAD.YET,
  533. C     &                  IFLU1.FLUX,IFLU2.FLUX,
  534. C     &                  CELLT)
  535.          ENDIF
  536. C
  537.          IF(LOGAN) GOTO 9999
  538.          IF(LOGNC) GOTO 9999
  539. C
  540. C******* Ecriture des flux
  541. C
  542. C        FLUX(1) = RO Un              RO Un
  543. C        FLUX(2) = RO Un Un + P   ->  RO Un Ux + P CNX
  544. C        FLUX(3) = RO Un Ut       ->  RO Un Uy + P CNY
  545. C        FLUX(4) = RO Un Et           RO Un Et
  546. C
  547.          SURF   = MPOVSU.VPOCHA(NLCF,1)
  548.          MPOVG1.VPOCHA(NLCF,1) = MPOVG1.VPOCHA(NLCF,1) +
  549.      &         (IFLU1.FLUX(1) * SURF )
  550.          MPOVG2.VPOCHA(NLCF,1) = MPOVG2.VPOCHA(NLCF,1) +
  551.      &         ((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX) * SURF)
  552.          MPOVG2.VPOCHA(NLCF,2) =  MPOVG2.VPOCHA(NLCF,2) +
  553.      &         ((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY) * SURF)
  554.          MPOVG3.VPOCHA(NLCF,1) = MPOVG3.VPOCHA(NLCF,1) +
  555.      &         (IFLU1.FLUX(4) * SURF)
  556.          IF(LOGME)THEN
  557.             DO I1 = 1, NESP
  558.                MPOVG4.VPOCHA(NLCF,I1)=IFLU1.FLUX(4+I1)
  559.      &                         * SURF
  560.             ENDDO
  561.          ENDIF
  562. C
  563. C******* Calcul du pas du temps (CFL)
  564. C
  565. C******  a) etat a l'interface
  566. C
  567.          DIAMG = MPOVDI.VPOCHA(NLCEG,1)
  568.          DIAMD = MPOVDI.VPOCHA(NLCED,1)
  569.          DIAM = MIN(DIAMG,DIAMD)
  570.          CELL  = 1.0D0/DIAM/CELLT
  571.          IF(CELL .GT. UNSDT)THEN
  572.             UNSDT  =  CELL
  573.             DIAMEL =  DIAMG
  574.             NLCEMI =  NLCEG
  575.          ENDIF
  576. C
  577. C******  b) etat gauche
  578. C
  579.          ASON    = SQRT(GAMG*PG/ROG)
  580.          LAMBDA = ABS(UNG) + ASON
  581.          CELL = LAMBDA / DIAM
  582.          IF(CELL .GT. UNSDT)THEN
  583.             UNSDT  =  CELL
  584.             DIAMEL =  DIAMG
  585.             NLCEMI =  NLCEG
  586.          ENDIF
  587. C
  588. C******  C) etat droite
  589. C
  590.          ASON    = SQRT(GAMD*PD/ROD)
  591.          LAMBDA = ABS(UND) + ASON
  592.          CELL = LAMBDA / DIAM
  593.          IF(CELL .GT. UNSDT)THEN
  594.             UNSDT  =  CELL
  595.             DIAMEL =  DIAMD
  596.             NLCEMI =  NLCED
  597.          ENDIF
  598. C
  599. C
  600. C**** Fin boucle sur FACEL
  601. C
  602.       ENDDO
  603. C
  604. C**** Pas du temps (condition de non interaction en 1D)
  605. C
  606.       DT = 0.5D0 / UNSDT
  607. C
  608. C**** Desactivation des segments et
  609. C     on detruit les MCHAMLs
  610. C
  611. C
  612. C**** SEGSUP FRAMAG
  613. C     SEGSUP FRAMAD
  614. C
  615. C     meme si LOGME = .FALSE.
  616. C
  617.       SEGSUP FRAMAG
  618.       SEGSUP FRAMAD
  619. C
  620.       SEGSUP MLENT1
  621.       SEGDES MLENT2
  622.       SEGDES IPT2
  623. C
  624.       SEGSUP IFLU1
  625.       SEGSUP IFLU2
  626. C
  627.       SEGDES MPOVSU
  628.       SEGDES MPOVDI
  629. C
  630.       SEGDES MPOVG1
  631.       SEGDES MPOVG2
  632.       SEGDES MPOVG3
  633. C
  634.       SEGDES MELRO
  635.       SEGDES MELP
  636.       SEGDES MELGAM
  637.       SEGDES MELVUN
  638.       SEGDES MELVUT
  639.       SEGDES MELVNX
  640.       SEGDES MELVNY
  641.       SEGDES MELT1X
  642.       SEGDES MELT1Y
  643. C
  644.       IF(LOGME) THEN
  645.          DO I1 = 1, NESP
  646.             MELVA1 = MCHAMY.IELVAL(I1)
  647.             SEGDES MELVA1
  648.          ENDDO
  649.          SEGDES MPOVG4
  650. C
  651.          SEGDES MCHAMY
  652.       ENDIF
  653. CC
  654.  9999 CONTINUE
  655. C
  656.       RETURN
  657.       END
  658. C
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.  

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