Télécharger la plaquette Cast3M


fr en

Télécharger ckon2.eso

Retour à la liste

Numérotation des lignes : 

ckon2

  1. C CKON2     SOURCE    OF166741  24/12/13    21:15:03     12097          
  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.       IMPLICIT INTEGER(I-N)
  132.       INTEGER I1
  133.      &       ,INDMET
  134.      &       ,IROF,IVITF,IPF,IGAMF,IFRMAF
  135.      &       ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
  136.      &       ,IGEOMC,IGEOMF
  137.      &       ,IZG1,IZG2,IZG3,IZG4,NLCEMI
  138.      &       ,NESP, NFAC
  139.      &       ,NLCF, NGCEG,  NGCED, NLCEG, NLCED
  140.      &       ,NGCF, NLCF1, SPG1, SPG2
  141.       REAL*8 DIAMEL, DT, UNSDT, CELLT
  142.      &     , ROG, UNG, UTG, UVG, PG, GAMG
  143.      &     , ROD, UND, UTD, UVD, PD, GAMD
  144.      &     , SURF,CNX, CNY, CNZ, CTX , CTY, CTZ
  145.      &     , CVX, CVY, CVZ
  146.      &     , CELL, DIAMG, DIAMD, DIAM
  147.      &     , ASON, LAMBDA
  148.       LOGICAL LOGME, LOGNC, LOGAN
  149.       CHARACTER*(40) MESERR
  150.       CHARACTER*(8) TYPE
  151. C
  152. C**** LES INCLUDES
  153. C
  154. -INC PPARAM
  155. -INC CCOPTIO
  156. -INC SMCOORD
  157. -INC SMCHAML
  158.       POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,MELVNZ.MELVAL,
  159.      &         MELT1X.MELVAL, MELT1Y.MELVAL,MELT1Z.MELVAL,
  160.      &         MELT2X.MELVAL, MELT2Y.MELVAL,MELT2Z.MELVAL
  161.       POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
  162.       POINTEUR MELRO.MELVAL, MELP.MELVAL,
  163.      &         MELGAM.MELVAL
  164. -INC SMCHPOI
  165.       POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  166.      &        , MPOVG1.MPOVAL, MPOVG2.MPOVAL
  167.      &        , MPOVG3.MPOVAL, MPOVG4.MPOVAL
  168.       POINTEUR MCHAMY.MCHAML
  169. -INC SMELEME
  170. -INC SMLMOTS
  171. -INC SMLENTI
  172. C
  173. C**** Les fractions massiques.
  174. C
  175.       SEGMENT FRAMAS
  176.          REAL*8 YET(NESP)
  177.       ENDSEGMENT
  178.       POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS
  179. C
  180. C**** Les flux aux interface dans le repaire (n,t,v)
  181. C
  182.       SEGMENT IFLUX
  183.          REAL*8 FLUX(NESP+5)
  184.       ENDSEGMENT
  185.       POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
  186. C
  187. C
  188. C**** Initialisation des MCHAMLs
  189. C
  190. C**** Masse volumique
  191. C
  192.       MCHEL1 = IROF
  193.       SEGACT MCHEL1
  194.       MCHAM1 = MCHEL1.ICHAML(1)
  195.       SEGACT MCHAM1
  196.       MELRO = MCHAM1.IELVAL(1)
  197.       SEGDES MCHEL1
  198.       SEGDES MCHAM1
  199. C
  200. C**** Pression
  201. C
  202.       MCHEL1 = IPF
  203.       SEGACT MCHEL1
  204.       MCHAM1 = MCHEL1.ICHAML(1)
  205.       SEGACT MCHAM1
  206.       MELP = MCHAM1.IELVAL(1)
  207.       SEGDES MCHEL1
  208.       SEGDES MCHAM1
  209. C
  210. C**** Gamma
  211. C
  212.       MCHEL1 = IGAMF
  213.       SEGACT MCHEL1
  214.       MCHAM1 = MCHEL1.ICHAML(1)
  215.       SEGACT MCHAM1
  216.       MELGAM = MCHAM1.IELVAL(1)
  217.       SEGDES MCHEL1
  218.       SEGDES MCHAM1
  219. C
  220. C**** Vitesse et cosinus directeurs du repere (n,t)
  221. C
  222.       MCHEL1 = IVITF
  223.       SEGACT MCHEL1
  224. C
  225. C**** La vitesse a comme SPG MELEFE
  226. C     Le cosinus directeurs ont comme SPG MELEMF
  227. C
  228. C     MCHAM1 -> Cosinus directeurs
  229. C     MCHAM2 -> Vitesse
  230. C
  231.       SPG1 = MCHEL1.IMACHE(1)
  232.       SPG2 = MCHEL1.IMACHE(2)
  233.       IF((SPG1 .EQ. MELEMF)  .AND. (SPG2 .EQ. MELEFE))THEN
  234.          MCHAM1 = MCHEL1.ICHAML(1)
  235.          MCHAM2 = MCHEL1.ICHAML(2)
  236.       ELSEIF((SPG1 .EQ. MELEFE)  .AND. (SPG2 .EQ. MELEMF))THEN
  237.          MCHAM1 = MCHEL1.ICHAML(2)
  238.          MCHAM2 = MCHEL1.ICHAML(1)
  239.       ELSE
  240.          LOGAN = .TRUE.
  241.          GOTO 9999
  242.       ENDIF
  243.       SEGACT MCHAM1
  244.       MELVNX = MCHAM1.IELVAL(1)
  245.       MELVNY = MCHAM1.IELVAL(2)
  246.       MELVNZ = MCHAM1.IELVAL(3)
  247.       MELT1X = MCHAM1.IELVAL(4)
  248.       MELT1Y = MCHAM1.IELVAL(5)
  249.       MELT1Z = MCHAM1.IELVAL(6)
  250.       MELT2X = MCHAM1.IELVAL(7)
  251.       MELT2Y = MCHAM1.IELVAL(8)
  252.       MELT2Z = MCHAM1.IELVAL(9)
  253.       SEGDES MCHAM1
  254.       SEGACT MCHAM2
  255.       MELVUN = MCHAM2.IELVAL(1)
  256.       MELVUT = MCHAM2.IELVAL(2)
  257.       MELVUV = MCHAM2.IELVAL(3)
  258.       SEGDES MCHAM2
  259.       SEGDES MCHEL1
  260. C
  261. C**** Fractions massiques
  262. C
  263.       IF(LOGME)THEN
  264.          MCHEL1 = IFRMAF
  265.          SEGACT MCHEL1
  266.          MCHAMY = MCHEL1.ICHAML(1)
  267.          SEGACT MCHAMY
  268. C
  269. C******* Numero d'especes dans les equations d'Euler
  270. C
  271.          NESP =  MCHAMY.IELVAL(/1)
  272.          DO I1 = 1, NESP
  273.             MELVA1 = MCHAMY.IELVAL(I1)
  274.             SEGACT MELVA1
  275.          ENDDO
  276.          SEGINI FRAMAG
  277.          SEGINI FRAMAD
  278.          SEGDES MCHEL1
  279.       ELSE
  280. C
  281. C******* Definition minimale de YET, necessaire pour transmetre YET aux
  282. C        subroutines FORTRAN qui calculent les flux
  283. C
  284.          NESP = 1
  285.          SEGINI FRAMAG
  286.          SEGINI FRAMAD
  287.          NESP = 0
  288.       ENDIF
  289. C
  290. C**** Initialisation des MELEMEs
  291. C
  292. C     'CENTRE', 'FACEL'
  293. C
  294.       IPT2 = MELEFE
  295.       SEGACT IPT2
  296.       NFAC = IPT2.NUM(/2)
  297. C
  298. C**** KRIPAD pour la correspondance global/local de centre
  299. C
  300.       CALL KRIPAD(MELEMC,MLENT1)
  301. C
  302. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  303. C
  304. C     Si i est le numero global d'un noeud de ICEN,
  305. C     MLENT1.LECT(i) contient sa position, i.e.
  306. C
  307. C     I              = numero global du noeud centre
  308. C     MLENT1.LECT(i) = numero local du noeud centre
  309. C
  310. C     MLENT1 déjà activé, i.e.
  311. C
  312. C     SEGACT MLENT1
  313. C
  314. C
  315. C**** KRIPAD pour la correspondance global/local de 'FACE'
  316. C
  317.       CALL KRIPAD(MELEMF,MLENT2)
  318. C
  319. C**** Initialisation de flux
  320. C
  321.       SEGINI IFLU1
  322.       SEGINI IFLU2
  323. C
  324. C**** IFLU2 = segment de travail en FLUVLH; c'est plus rapide le definir ici
  325. C
  326. C
  327. C**** CHPOINTs de la table DOMAINE
  328. C
  329.       CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  330.       CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
  331. C
  332. C**** LICHT active les MPOVALs en *MOD
  333. C
  334. C     i.e.
  335. C
  336. C     SEGACT MPOVSU*MOD
  337. C     SEGACT MPOVDI*MOD
  338. C
  339. C
  340. C**** Les FLUX aux face
  341. C
  342. C     La densité
  343. C
  344.       CALL LICHT(IZG1,MPOVG1,TYPE,IGEOMF)
  345. C
  346. C     SEGACT MPOVG1*MOD
  347. C
  348. C**** Les debits
  349. C
  350.       CALL LICHT(IZG2,MPOVG2,TYPE,IGEOMF)
  351. C
  352. C     SEGACT MPOVG2*MOD
  353. C
  354. C**** L'energie totale volumique
  355. C
  356.       CALL LICHT(IZG3,MPOVG3,TYPE,IGEOMF)
  357. C
  358. C     SEGACT MPOVG3*MOD
  359. C
  360. C**** Les Fractions Massiques
  361. C
  362.       IF(LOGME)THEN
  363.          CALL LICHT(IZG4,MPOVG4,TYPE,IGEOMF)
  364. C
  365. C        SEGACT MPOVG4*MOD
  366. C
  367.       ENDIF
  368. C
  369. C**** Activation des MCHAMLs
  370. C
  371.       SEGACT MELRO
  372.       SEGACT MELP
  373.       SEGACT MELGAM
  374.       SEGACT MELVUN
  375.       SEGACT MELVUT
  376.       SEGACT MELVUV
  377.       SEGACT MELVNX
  378.       SEGACT MELVNY
  379.       SEGACT MELVNZ
  380.       SEGACT MELT1X
  381.       SEGACT MELT1Y
  382.       SEGACT MELT1Z
  383.       SEGACT MELT2X
  384.       SEGACT MELT2Y
  385.       SEGACT MELT2Z
  386. C
  387. C**** Initialisation de 1/DT
  388. C
  389.       UNSDT = 0.0D0
  390. C
  391. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  392. C
  393.       DO NLCF = 1, NFAC
  394. C
  395. C******* NLCF  = numero local du centre de facel
  396. C        NGCF  = numero global du centre de facel
  397. C        NLCF1 = numero local du centre de face
  398. C        NGCEG = numero global du centre ELT "gauche"
  399. C        NLCEG = numero local du centre ELT "gauche"
  400. C        NGCED = numero global du centre ELT "droite"
  401. C        NLCED = numero local du centre ELT "droite"
  402. C
  403.          NGCEG = IPT2.NUM(1,NLCF)
  404.          NGCED = IPT2.NUM(3,NLCF)
  405.          NGCF  = IPT2.NUM(2,NLCF)
  406.          NLCF1 = MLENT2.LECT(NGCF)
  407.          NLCEG = MLENT1.LECT(NGCEG)
  408.          NLCED = MLENT1.LECT(NGCED)
  409. C
  410. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  411. C
  412.          IF(NLCF .NE. NLCF1)THEN
  413.             MESERR = 'FACEL et FACE = ?                       '
  414.             LOGAN = .TRUE.
  415.             GOTO 9999
  416.          ENDIF
  417. C
  418. C******* Recuperation des Etats "gauche" et "droite"
  419. C
  420.          ROG = MELRO.VELCHE(1,NLCF)
  421.          UNG = MELVUN.VELCHE(1,NLCF)
  422.          UTG = MELVUT.VELCHE(1,NLCF)
  423.          UVG = MELVUV.VELCHE(1,NLCF)
  424.          PG = MELP.VELCHE(1,NLCF)
  425.          GAMG = MELGAM.VELCHE(1,NLCF)
  426. C
  427.          ROD = MELRO.VELCHE(3,NLCF)
  428.          UND = MELVUN.VELCHE(3,NLCF)
  429.          UTD = MELVUT.VELCHE(3,NLCF)
  430.          UVD = MELVUV.VELCHE(3,NLCF)
  431.          PD = MELP.VELCHE(3,NLCF)
  432.          GAMD = MELGAM.VELCHE(3,NLCF)
  433. C
  434.          CNX = MELVNX.VELCHE(1,NLCF)
  435.          CNY = MELVNY.VELCHE(1,NLCF)
  436.          CNZ = MELVNZ.VELCHE(1,NLCF)
  437.          CTX = MELT1X.VELCHE(1,NLCF)
  438.          CTY = MELT1Y.VELCHE(1,NLCF)
  439.          CTZ = MELT1Z.VELCHE(1,NLCF)
  440.          CVX = MELT2X.VELCHE(1,NLCF)
  441.          CVY = MELT2Y.VELCHE(1,NLCF)
  442.          CVZ = MELT2Z.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 FLURI2(NESP,
  466.      &                  GAMG,ROG,PG,UNG,UTG,UVG,
  467.      &                  GAMD,ROD,PD,UND,UTD,UVD,
  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 FLUXV2(NESP,
  483.      &                  GAMG,ROG,PG,UNG,UTG,UVG,
  484.      &                  GAMD,ROD,PD,UND,UTD,UVD,
  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 FLUVL2(NESP,
  498.      &                  GAMG,ROG,PG,UNG,UTG,UVG,
  499.      &                  GAMD,ROD,PD,UND,UTD,UVD,
  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 FLHU21(NESP,
  508.      &                  GAMG,ROG,PG,UNG,UTG,UVG,
  509.      &                  GAMD,ROD,PD,UND,UTD,UVD,
  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 FLHU22(NESP,
  519.      &                  GAMG,ROG,PG,UNG,UTG,UVG,
  520.      &                  GAMD,ROD,PD,UND,UTD,UVD,
  521.      &                  FRAMAG.YET,FRAMAD.YET,
  522.      &                  IFLU1.FLUX,IFLU2.FLUX,
  523.      &                  CELLT,
  524.      &                  LOGNC,MESERR,LOGAN)
  525.          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.              CALL ERREUR(251)
  536.          ENDIF
  537. C
  538.          IF(LOGAN) GOTO 9999
  539.          IF(LOGNC) GOTO 9999
  540. C
  541. C******* Ecriture des flux
  542. C
  543. C        FLUX(1) = RO Un              RO Un
  544. C        FLUX(2) = RO Un Un + P   ->  RO Un Ux + P CNX
  545. C        FLUX(3) = RO Un Ut       ->  RO Un Uy + P CNY
  546. C        FLUX(4) = RO Un Et           RO Un Et
  547. C
  548.          SURF   = MPOVSU.VPOCHA(NLCF,1)
  549.          MPOVG1.VPOCHA(NLCF,1) = MPOVG1.VPOCHA(NLCF,1) +
  550.      &         (IFLU1.FLUX(1) * SURF )
  551.          MPOVG2.VPOCHA(NLCF,1) = MPOVG2.VPOCHA(NLCF,1) +
  552.      &((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX+IFLU1.FLUX(4)*CVX) * SURF)
  553.          MPOVG2.VPOCHA(NLCF,2) =  MPOVG2.VPOCHA(NLCF,2) +
  554.      &((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY+IFLU1.FLUX(4)*CVY) * SURF)
  555.          MPOVG2.VPOCHA(NLCF,3) =  MPOVG2.VPOCHA(NLCF,3) +
  556.      &((IFLU1.FLUX(2)*CNZ+IFLU1.FLUX(3)*CTZ+IFLU1.FLUX(4)*CVZ) * SURF)
  557.          MPOVG3.VPOCHA(NLCF,1) = MPOVG3.VPOCHA(NLCF,1) +
  558.      &         (IFLU1.FLUX(5) * SURF)
  559.          IF(LOGME)THEN
  560.             DO I1 = 1, NESP
  561.                MPOVG4.VPOCHA(NLCF,I1)=IFLU1.FLUX(5+I1)
  562.      &                         * SURF
  563.             ENDDO
  564.          ENDIF
  565. C
  566. C******* Calcul du pas du temps (CFL)
  567. C
  568. C******  a) etat a l'interface
  569. C
  570.          DIAMG = MPOVDI.VPOCHA(NLCEG,1)
  571.          DIAMD = MPOVDI.VPOCHA(NLCED,1)
  572.          DIAM = (DIAMG+DIAMD)/2.0D0
  573.          CELL  = 1.0D0/DIAM/CELLT
  574.          IF(CELL .GT. UNSDT)THEN
  575.             UNSDT  =  CELL
  576.             DIAMEL =  DIAM
  577.             NLCEMI =  NLCEG
  578.          ENDIF
  579. C
  580. C******  b) etat gauche
  581. C
  582.          ASON    = SQRT(GAMG*PG/ROG)
  583.          LAMBDA = ABS(UNG) + ASON
  584.          CELL = LAMBDA / DIAM
  585.          IF(CELL .GT. UNSDT)THEN
  586.             UNSDT  =  CELL
  587.             DIAMEL =  DIAM
  588.             NLCEMI =  NLCEG
  589.          ENDIF
  590. C
  591. C******  C) etat droite
  592. C
  593.          ASON    = SQRT(GAMD*PD/ROD)
  594.          LAMBDA = ABS(UND) + ASON
  595.          CELL = LAMBDA / DIAM
  596.          IF(CELL .GT. UNSDT)THEN
  597.             UNSDT  =  CELL
  598.             DIAMEL =  DIAM
  599.             NLCEMI =  NLCED
  600.          ENDIF
  601. C
  602. C
  603. C**** Fin boucle sur FACEL
  604. C
  605.       ENDDO
  606. C
  607. C**** Pas du temps (condition de non interaction en 1D)
  608. C
  609.       DT = 0.5D0 / UNSDT
  610. C
  611. C**** Desactivation des segments et
  612. C     on detruit les MCHAMLs
  613. C
  614. C
  615. C**** SEGSUP FRAMAG
  616. C     SEGSUP FRAMAD
  617. C
  618. C     meme si LOGME = .FALSE.
  619. C
  620.       SEGSUP FRAMAG
  621.       SEGSUP FRAMAD
  622. C
  623.       SEGSUP MLENT1
  624.       SEGDES MLENT2
  625.       SEGDES IPT2
  626. C
  627.       SEGSUP IFLU1
  628.       SEGSUP IFLU2
  629. C
  630.       SEGDES MPOVSU
  631.       SEGDES MPOVDI
  632. C
  633.       SEGDES MPOVG1
  634.       SEGDES MPOVG2
  635.       SEGDES MPOVG3
  636. C
  637.       SEGDES MELRO
  638.       SEGDES MELP
  639.       SEGDES MELGAM
  640.       SEGDES MELVUN
  641.       SEGDES MELVUT
  642.       SEGDES MELVUV
  643.       SEGDES MELVNX
  644.       SEGDES MELVNY
  645.       SEGDES MELVNZ
  646.       SEGDES MELT1X
  647.       SEGDES MELT1Y
  648.       SEGDES MELT1Z
  649.       SEGDES MELT2X
  650.       SEGDES MELT2Y
  651.       SEGDES MELT2Z
  652. C
  653.       IF(LOGME) THEN
  654.          DO I1 = 1, NESP
  655.             MELVA1 = MCHAMY.IELVAL(I1)
  656.             SEGDES MELVA1
  657.          ENDDO
  658.          SEGDES MPOVG4
  659. C
  660.          SEGDES MCHAMY
  661.       ENDIF
  662. CC
  663.  9999 CONTINUE
  664. C
  665.       RETURN
  666.       END
  667. C
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  

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