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

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