Télécharger konfl3.eso

Retour à la liste

konfl3
C KONFL3    SOURCE    OF166741  24/12/13    21:16:25     12097          
      SUBROUTINE KONFL3(LOGME,INDMET,
     &          IROF,IVITF,IPF,IGAMF,IFRMAF,
     &          ICHPSU,ICHPDI,
     &          MELEMC,MELEMF,MELEFE,MELLIM,
     &          IUINF,IUPRI,
     &          ICHFLU,DT,
     &          LOGNC,LOGAN,MESERR)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KONFL3
C
C DESCRIPTION       :  Voir KONV11
C
C                      Cas trois dimensions, gaz "calorically perfect"
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, SFME, LTMF
C
C************************************************************************
C
C ENTREES
C
C
C  1) PARAMETRES
C
C     LOGME   : (LOGICAL);  .TRUE.  -> MULTI-ESPECES
C                           .FALSE. -> MONO-ESPECE
C
C     INDMET  :     1        Godunov
C
C                   2        van Leer FVS
C
C                   3        van Leer Hanel FVS
C
C                   4        HUS (Van Leer FVS + Osher FDS)
C
C                   5        HUS (Van Leer - Hanel FVS + Osher FDS)
C
C                   6        AUSM+
C
C                   9        AUSM+ Low Mach
C
C  2) Pointeurs des MCHAMLs
C
C     IROF    : MCHAML sur "FACEL"  contenant la masse volumique
C     ("gauche" et "droite");
C
C     IVITF   : MCHAML sur "FACEL"  contenant la vitesse dans le repaire
C               local (n,t) et les cosinus directeurs des repaire local;
C
C     IPF     : MCHAML sur "FACEL"  contenant la pression;
C
C     IGAMF   : MCHAML sur "FACEL"  contenant le gamma;
C
C     IFRAMAF : MCHAML sur "FACEL",  contenant les fractions massiques
C               si LOGME = .TRUE.;
C               LOGME = .FALSE. -> IFRAMAF = 0
C
C
C  3) Pointeurs de CHPOINTs de la table DOMAINE
C
C     ICHPSU  : CHPOINT "FACE" contenant la surface des faces
C
C     ICHPDI  : CHPOINT "CENTRE" contenant le diametre minimum
C               de chaque element
C
C
C  4) Pointeurs de MELEME
C
C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
C
C     MELEMF  : MELEME 'FACE' du SPG des FACES
C
C     MELEFE  : MELEME 'FACEL' du connectivité FACES -> ELEM
C
C     MELLIM  : MELEME SPG des conditions aux bords
C
C  5) Cas Bas MACH
C
C     IUINF   : CHPOINT, one component, "cut-off velocity"
C               0 if no Bas MACH
C
C     IUPRI   : CHPOINT, one component, "minimum reference velocity"
C               0 if no BAs Mach
C
C SORTIES
C
C     ICHFLU     : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
C
C     DT      : pas de temps pour le respect de la CFL-like condition
C               DT < DIAMMIN /2 /max(Lambda_i)
C               En maillage regulier cette condition garantie la
C               non-interaction des ondes
C
C
C     LOGNC   : (LOGICAL): si .TRUE. la methode de Newton-Rapson, utilisée
C               dans pour la solution du probleme Riemann exacte ou dans
C               l'algorithm HUS, n'a pas bien marchéee; MESERR = 'Goudunov'
C               ou 'HUS'.
C
C     LOGAN   : (LOGICAL): si .TRUE. une anomalie à été detectée
C
C     MESERR  : pour l'ecriture des messages d'erreurs
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C              02/05/2005 par T. KLOCZKO (DEN/DM2S/SFME/LTMF)
C              Ajout de 3 méthodes de décentrement dont 2 pour les écoulements
C              bas-Mach.
C
C  INDMET  :  10     Rusanov
C             11     Rusanov Low-Mach
C             13     ROE Low-Mach
C
C************************************************************************
C
C
C N.B.: On suppose qu'on a déjà controllé RO, P > 0
C                                         GAMMA \in (1,3)
C                                         Y \in (0,1)
C       Si non il faut le faire!!!
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      INTEGER I1
     &       ,INDMET
     &       ,IROF,IVITF,IPF,IGAMF,IFRMAF
     &       ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
     &       ,IGEOMC,IGEOMF
     &       ,IUINF,IUPRI
     &       ,ICHFLU
     &       ,NESP, NFAC
     &       ,NLCF, NGCEG,  NGCED, NLCEG, NLCED
     &       ,NGCF, NLCF1, SPG1, SPG2
      REAL*8 DT, UNSDT, CELLT
     &     , ROG, UNG, UTG, UVG, PG, GAMG
     &     , ROD, UND, UTD, UVD, PD, GAMD
     &     , SURF,CNX, CNY, CNZ, CTX , CTY, CTZ
     &     , CVX, CVY, CVZ, V_INF
     &     , CELL, DIAMG, DIAMD, DIAM
     &     , ASON, LAMBDA
      LOGICAL LOGME, LOGNC, LOGAN
      CHARACTER*(40) MESERR
      CHARACTER*(8) TYPE
C
C**** LES INCLUDES
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHAML
      POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,MELVNZ.MELVAL,
     &         MELT1X.MELVAL, MELT1Y.MELVAL,MELT1Z.MELVAL,
     &         MELT2X.MELVAL, MELT2Y.MELVAL,MELT2Z.MELVAL
      POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
      POINTEUR MELRO.MELVAL, MELP.MELVAL,
     &         MELGAM.MELVAL
-INC SMCHPOI
      POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
     &        , MPOFLU.MPOVAL
     &        , MPUINF.MPOVAL, MPUPRI.MPOVAL
      POINTEUR MCHAMY.MCHAML
-INC SMELEME
      POINTEUR MELLIM.MELEME
-INC SMLMOTS
-INC SMLENTI
      POINTEUR MLELIM.MLENTI
C
C**** Les fractiones massiques.
C
      SEGMENT FRAMAS
         REAL*8 YET(NESP)
      ENDSEGMENT
      POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS
C
C**** Les flux aux interface dans le repaire (n,t,v)
C
      SEGMENT IFLUX
         REAL*8 FLUX(NESP+5)
      ENDSEGMENT
      POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
C
C**** KRIPAD pour la correspondance global/local des conditions limits
C
      CALL KRIPAD(MELLIM,MLELIM)
C     SEGACT MELLIM
C
C**** Initialisation des MCHAMLs
C
C**** Masse volumique
C
      MCHEL1 = IROF
      SEGACT MCHEL1
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGACT MCHAM1
      MELRO = MCHAM1.IELVAL(1)
      SEGDES MCHEL1
      SEGDES MCHAM1
C
C**** Pression
C
      MCHEL1 = IPF
      SEGACT MCHEL1
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGACT MCHAM1
      MELP = MCHAM1.IELVAL(1)
      SEGDES MCHEL1
      SEGDES MCHAM1
C
C**** Gamma
C
      MCHEL1 = IGAMF
      SEGACT MCHEL1
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGACT MCHAM1
      MELGAM = MCHAM1.IELVAL(1)
      SEGDES MCHEL1
      SEGDES MCHAM1
C
C**** Vitesse et cosinus directeurs du repere (n,t)
C
      MCHEL1 = IVITF
      SEGACT MCHEL1
C
C**** La vitesse a comme SPG MELEFE
C     Le cosinus directeurs ont comme SPG MELEMF
C
C     MCHAM1 -> Cosinus directeurs
C     MCHAM2 -> Vitesse
C
      SPG1 = MCHEL1.IMACHE(1)
      SPG2 = MCHEL1.IMACHE(2)
      IF((SPG1 .EQ. MELEMF)  .AND. (SPG2 .EQ. MELEFE))THEN
         MCHAM1 = MCHEL1.ICHAML(1)
         MCHAM2 = MCHEL1.ICHAML(2)
      ELSEIF((SPG1 .EQ. MELEFE)  .AND. (SPG2 .EQ. MELEMF))THEN
         MCHAM1 = MCHEL1.ICHAML(2)
         MCHAM2 = MCHEL1.ICHAML(1)
      ELSE
         LOGAN = .TRUE.
         GOTO 9999
      ENDIF
      SEGACT MCHAM1
      MELVNX = MCHAM1.IELVAL(1)
      MELVNY = MCHAM1.IELVAL(2)
      MELVNZ = MCHAM1.IELVAL(3)
      MELT1X = MCHAM1.IELVAL(4)
      MELT1Y = MCHAM1.IELVAL(5)
      MELT1Z = MCHAM1.IELVAL(6)
      MELT2X = MCHAM1.IELVAL(7)
      MELT2Y = MCHAM1.IELVAL(8)
      MELT2Z = MCHAM1.IELVAL(9)
      SEGDES MCHAM1
      SEGACT MCHAM2
      MELVUN = MCHAM2.IELVAL(1)
      MELVUT = MCHAM2.IELVAL(2)
      MELVUV = MCHAM2.IELVAL(3)
      SEGDES MCHAM2
      SEGDES MCHEL1
C
C**** Fractions massiques
C
      IF(LOGME)THEN
         MCHEL1 = IFRMAF
         SEGACT MCHEL1
         MCHAMY = MCHEL1.ICHAML(1)
         SEGACT MCHAMY
C
C******* Numero d'especes dans les equations d'Euler
C
         NESP =  MCHAMY.IELVAL(/1)
         DO I1 = 1, NESP
            MELVA1 = MCHAMY.IELVAL(I1)
            SEGACT MELVA1
         ENDDO
         SEGINI FRAMAG
         SEGINI FRAMAD
         SEGDES MCHEL1
      ELSE
C
C******* Definition minimale de YET, necessaire pour transmetre YET aux
C        subroutines FORTRAN qui calculent les flux
C
         NESP = 1
         SEGINI FRAMAG
         SEGINI FRAMAD
         NESP = 0
      ENDIF
C
C**** Initialisation des MELEMEs
C
C     'CENTRE', 'FACEL'
C
      IPT2 = MELEFE
      SEGACT IPT2
      NFAC = IPT2.NUM(/2)
C
C**** KRIPAD pour la correspondance global/local de centre
C
      CALL KRIPAD(MELEMC,MLENT1)
C
C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
C
C     Si i est le numero global d'un noeud de ICEN,
C     MLENT1.LECT(i) contient sa position, i.e.
C
C     I              = numero global du noeud centre
C     MLENT1.LECT(i) = numero local du noeud centre
C
C     MLENT1 déjà activé, i.e.
C
C     SEGACT MLENT1
C
C
C**** KRIPAD pour la correspondance global/local de 'FACE'
C
      CALL KRIPAD(MELEMF,MLENT2)
C
C**** Initialisation de flux
C
      SEGINI IFLU1
      SEGINI IFLU2
C
C**** IFLU2 = segment de travail en FLUVLH; c'est plus rapide le definir ici
C
C
C**** CHPOINTs de la table DOMAINE
C
      CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
      CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT MPOVSU*MOD
C     SEGACT MPOVDI*MOD
C
C
C**** Les FLUX aux face
C
C     La densité
C
      CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
C     SEGACT MPOFLU*MOD
C
C**** Activation des MCHAMLs
C
      SEGACT MELRO
      SEGACT MELP
      SEGACT MELGAM
      SEGACT MELVUN
      SEGACT MELVUT
      SEGACT MELVUV
      SEGACT MELVNX
      SEGACT MELVNY
      SEGACT MELVNZ
      SEGACT MELT1X
      SEGACT MELT1Y
      SEGACT MELT1Z
      SEGACT MELT2X
      SEGACT MELT2Y
      SEGACT MELT2Z
C********************************************************
C     Bas Mach
C*******************************************************
      IF(IUINF .NE. 0)THEN
         CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC)
         CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC)
      ELSE
         MPUPRI=0
         MPUINF=0
      ENDIF
C*******************************************************
C**** Initialisation de 1/DT
C*******************************************************
      UNSDT = 0.0D0
C
C**** BOUCLE SUR FACEL pour le calcul du FLUX
C
      DO NLCF = 1, NFAC
C
C******* NLCF  = numero local du centre de facel
C        NGCF  = numero global du centre de facel
C        NLCF1 = numero local du centre de face
C        NGCEG = numero global du centre ELT "gauche"
C        NLCEG = numero local du centre ELT "gauche"
C        NGCED = numero global du centre ELT "droite"
C        NLCED = numero local du centre ELT "droite"
C
         NGCEG = IPT2.NUM(1,NLCF)
         NGCED = IPT2.NUM(3,NLCF)
         NGCF  = IPT2.NUM(2,NLCF)
         NLCF1 = MLENT2.LECT(NGCF)
         NLCEG = MLENT1.LECT(NGCEG)
         NLCED = MLENT1.LECT(NGCED)
         NLFL = MLELIM.LECT(NGCF)
C
C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
C
         IF(NLCF .NE. NLCF1)THEN
            MESERR = 'FACEL et FACE = ?                       '
            LOGAN = .TRUE.
            GOTO 9999
         ENDIF
         IF(NLFL .EQ. 0)THEN
C
C******* Recuperation des Etats "gauche" et "droite"
C
            ROG = MELRO.VELCHE(1,NLCF)
            UNG = MELVUN.VELCHE(1,NLCF)
            UTG = MELVUT.VELCHE(1,NLCF)
            UVG = MELVUV.VELCHE(1,NLCF)
            PG = MELP.VELCHE(1,NLCF)
            GAMG = MELGAM.VELCHE(1,NLCF)
C
            ROD = MELRO.VELCHE(3,NLCF)
            UND = MELVUN.VELCHE(3,NLCF)
            UTD = MELVUT.VELCHE(3,NLCF)
            UVD = MELVUV.VELCHE(3,NLCF)
            PD = MELP.VELCHE(3,NLCF)
            GAMD = MELGAM.VELCHE(3,NLCF)
C
            CNX = MELVNX.VELCHE(1,NLCF)
            CNY = MELVNY.VELCHE(1,NLCF)
            CNZ = MELVNZ.VELCHE(1,NLCF)
            CTX = MELT1X.VELCHE(1,NLCF)
            CTY = MELT1Y.VELCHE(1,NLCF)
            CTZ = MELT1Z.VELCHE(1,NLCF)
            CVX = MELT2X.VELCHE(1,NLCF)
            CVY = MELT2Y.VELCHE(1,NLCF)
            CVZ = MELT2Z.VELCHE(1,NLCF)
C
C******* Le fractiones massiques
C
            IF(LOGME)THEN
               DO I1 = 1, NESP
                  MELVA1 = MCHAMY.IELVAL(I1)
                  FRAMAG.YET(I1) = MELVA1.VELCHE(1,NLCF)
                  FRAMAD.YET(I1) = MELVA1.VELCHE(3,NLCF)
               ENDDO
            ENDIF
C
C******* On a defini (ROg,ROUNg,ROUTg,Pg,(Yg)), (ROd,ROUNd,ROUTd,Pd,(Yd))
C        et on a déjà verifié ROg, ROd, Pg, Pd > 0 et 0<Y_i<1
C
C
C******* Calcul du flux aux interfaces
C
            IF(INDMET .EQ. 1)THEN
C
C******* GODUNOV
C        FLURIE en FORTRAN STANDARD
C
               CALL FLURI2(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,
     &                  CELLT,
     &                  LOGNC,LOGAN,MESERR)
C
            ELSEIF(INDMET .EQ. 2)THEN
C
C******* Van Leer FVS
C
C        N.B: FLUXVL en FORTRAN pure
C             FRAMAG.YET = table d'un pointeur -> table
C             La meme chose pour FRAMAD.YET, IFLU1.FLUX,
C             IFLU2.FLUX
C
               CALL FLUXV2(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,IFLU2.FLUX,
     &                  CELLT)
            ELSEIF(INDMET .EQ. 3)THEN
C
C******* Van Leer - Hanel FVS
C
C        N.B: FLUVLH en FORTRAN pure
C             FRAMAG.YET = table d'un pointeur -> table
C             La meme chose pour FRAMAD.YET, IFLU1.FLUX,
C             IFLU2.FLUX
C
               CALL FLUVL2(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,IFLU2.FLUX,
     &                  CELLT)
            ELSEIF(INDMET .EQ. 4)THEN
C
C******* HUS (Van Leer FVS + Osher FDS)
C
               CALL FLHU21(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,IFLU2.FLUX,
     &                  CELLT,
     &                  LOGNC,MESERR,LOGAN)
            ELSEIF(INDMET .EQ. 5)THEN
C
C******* HUS (Van Leer - Hanel FVS + Osher FDS)
C
               CALL FLHU22(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,IFLU2.FLUX,
     &                  CELLT,
     &                  LOGNC,MESERR,LOGAN)
            ELSEIF(INDMET .EQ. 6)THEN
C
C******** AUSM+ (Liou)
C
               CALL FAUSM3(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,
     &                  CELLT)
C
C******** AUSM+(P) for low-Mach number flows (Edwards and Liou)
C
            ELSEIF(INDMET .EQ. 9)THEN
               V_INF=MAX(MPUINF.VPOCHA(NLCEG,1),
     &              MPUINF.VPOCHA(NLCED,1),
     &              MPUPRI.VPOCHA(NLCEG,1),
     &              MPUPRI.VPOCHA(NLCED,1))
               CALL FAUSM4(NESP,
     &              GAMG,ROG,PG,UNG,UTG,UVG,
     &              GAMD,ROD,PD,UND,UTD,UVD,
     &              FRAMAG.YET,FRAMAD.YET,
     &              V_INF,
     &              IFLU1.FLUX,
     &              CELLT)
C
C******** RUSANOV Scheme
C
            ELSEIF(INDMET .EQ. 10)THEN
               CALL FRUSA3(NESP,
     &                  GAMG,ROG,PG,UNG,UTG,UVG,
     &                  GAMD,ROD,PD,UND,UTD,UVD,
     &                  FRAMAG.YET,FRAMAD.YET,
     &                  IFLU1.FLUX,
     &                  CELLT)
C
C******** RUSANOV Scheme for Low-Mach number flows
C
            ELSEIF(INDMET .EQ. 11)THEN
               V_INF=MAX(MPUINF.VPOCHA(NLCEG,1),
     &              MPUINF.VPOCHA(NLCED,1),
     &              MPUPRI.VPOCHA(NLCEG,1),
     &              MPUPRI.VPOCHA(NLCED,1))
               CALL FRUSB3(NESP,
     &              GAMG,ROG,PG,UNG,UTG,UVG,
     &              GAMD,ROD,PD,UND,UTD,UVD,
     &              FRAMAG.YET,FRAMAD.YET,
     &              V_INF,
     &              IFLU1.FLUX,
     &              CELLT)
C
C******* Centered scheme
C
            ELSEIF(INDMET .EQ. 12)THEN
               CALL FVCEN3(NESP,
     &              GAMG,ROG,PG,UNG,UTG,UVG,
     &              GAMD,ROD,PD,UND,UTD,UVD,
     &              FRAMAG.YET,FRAMAD.YET,
     &              IFLU1.FLUX,
     &              CELLT)
C
C******** ROE-TURKEL schem for low-Mach number flows
C
            ELSEIF(INDMET .EQ. 13)THEN
               V_INF=MAX(MPUINF.VPOCHA(NLCEG,1),
     &              MPUINF.VPOCHA(NLCED,1),
     &              MPUPRI.VPOCHA(NLCEG,1),
     &              MPUPRI.VPOCHA(NLCED,1))
               CALL FROEB3(NESP,
     &              GAMG,ROG,PG,UNG,UTG,UVG,
     &              GAMD,ROD,PD,UND,UTD,UVD,
     &              FRAMAG.YET,FRAMAD.YET,
     &              V_INF,
     &              IFLU1.FLUX,
     &              CELLT)
            ENDIF
C
            IF(LOGAN) GOTO 9999
            IF(LOGNC) GOTO 9999
C
C******* Ecriture des flux
C
C        FLUX(1) = RO Un              RO Un
C        FLUX(2) = RO Un Un + P   ->  RO Un Ux + P CNX
C        FLUX(3) = RO Un Ut       ->  RO Un Uy + P CNY
C        FLUX(4) = RO Un Et           RO Un Et
C
            SURF   = MPOVSU.VPOCHA(NLCF,1)
            MPOFLU.VPOCHA(NLCF,1) =
     &           (IFLU1.FLUX(1) * SURF )
            MPOFLU.VPOCHA(NLCF,2) =
     &           ((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX+IFLU1.FLUX(4)*CVX
     $           )* SURF)
            MPOFLU.VPOCHA(NLCF,3) =
     &           ((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY+IFLU1.FLUX(4)*CVY
     $           )* SURF)
            MPOFLU.VPOCHA(NLCF,4) =
     &           ((IFLU1.FLUX(2)*CNZ+IFLU1.FLUX(3)*CTZ+IFLU1.FLUX(4)*CVZ
     $           )* SURF)
            MPOFLU.VPOCHA(NLCF,5) =
     &           (IFLU1.FLUX(5) * SURF)
            IF(LOGME)THEN
               DO I1 = 1, NESP, 1
                  MPOFLU.VPOCHA(NLCF,5+I1) = IFLU1.FLUX(5+I1)
     &                 * SURF
               ENDDO
            ENDIF
C
C******* Calcul du pas du temps (CFL)
C
C******  a) etat a l'interface
C
            DIAMG = MPOVDI.VPOCHA(NLCEG,1)
            DIAMD = MPOVDI.VPOCHA(NLCED,1)
            DIAM = (DIAMG+DIAMD)/2.0D0
            CELL  = 1.0D0/DIAM/CELLT
            IF(CELL .GT. UNSDT)THEN
               UNSDT  =  CELL
            ENDIF
C
C******  b) etat gauche
C
            ASON    = SQRT(GAMG*PG/ROG)
            LAMBDA = ABS(UNG) + ASON
            CELL = LAMBDA / DIAM
            IF(CELL .GT. UNSDT)THEN
               UNSDT  =  CELL
            ENDIF
C
C******  C) etat droite
C
            ASON    = SQRT(GAMD*PD/ROD)
            LAMBDA = ABS(UND) + ASON
            CELL = LAMBDA / DIAM
            IF(CELL .GT. UNSDT)THEN
               UNSDT  =  CELL
            ENDIF
C
C**** Fin boucle sur FACEL
C
         ENDIF
      ENDDO
C
C**** Pas du temps (condition de non interaction en 1D)
C
      DT = 0.5D0 / UNSDT
C
C**** Desactivation des segments et
C     on detruit les MCHAMLs
C
C
C**** SEGSUP FRAMAG
C     SEGSUP FRAMAD
C     meme si LOGME = .FALSE.
C
      SEGSUP FRAMAG
      SEGSUP FRAMAD
C
      SEGSUP MLENT1
      SEGDES MLENT2
      SEGDES IPT2
C
      SEGSUP IFLU1
      SEGSUP IFLU2
C
      SEGDES MPOVSU
      SEGDES MPOVDI
C
      SEGDES MPOFLU
C
      SEGDES MELRO
      SEGDES MELP
      SEGDES MELGAM
      SEGDES MELVUN
      SEGDES MELVUT
      SEGDES MELVUV
      SEGDES MELVNX
      SEGDES MELVNY
      SEGDES MELVNZ
      SEGDES MELT1X
      SEGDES MELT1Y
      SEGDES MELT1Z
      SEGDES MELT2X
      SEGDES MELT2Y
      SEGDES MELT2Z
C
      IF(LOGME) THEN
         DO I1 = 1, NESP
            MELVA1 = MCHAMY.IELVAL(I1)
            SEGDES MELVA1
         ENDDO
C
         SEGDES MCHAMY
      ENDIF
      SEGSUP MLELIM
CC
 9999 CONTINUE
C
      RETURN
      END
C
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

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