Sources Esope | Cast3M

pre711
C PRE711    SOURCE    CB215821  23/01/25    21:15:30     11573          
      SUBROUTINE PRE711(NESP,MLMESP,
     &     ICEN,IFACE,IFACEL,INORM,
     &     IPHI, IGRPHI, ILIPHI,
     &     IRN1, IGRRN1, ILIRN1,
     &     IVN1, IGRVN1, ILIVN1,
     &     IPN1, IGRPN1, ILIPN1,
     &     IYMA, IGRYMA, ILIYMA,
     &     IALC, IGRALC, ILIALC,
     &     IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE711
C
C DESCRIPTION       :  Voir PRE71
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C ENTREES
C
C     NESP : number of the species involved in the EULER equations.
C
C     MLMESP : MLMOTS object;  names of the species involved in the
C              EULER equations.
C
C     1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
C
C     ICEN    : MELEME de 'POI1' SPG des CENTRES
C
C     IFACE   : MELEME de 'POI1' SPG des FACES
C
C     IFACEL  : MELEME de 'SEG3' avec
C               CENTRE d'Elt "gauche"
C               CENTRE de Face
C               CENTRE d'Elt "droite"
C
C               N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
C
C     INORM   : CHPOINT des cosinus directeurs de normales aux faces
C
C     2) Autres pointeurs
C
C     IPHI, IGRPHI, ILIPHI,
C     CHPOINT "CENTRE" de phi, gradient et limiteur
C
C     IRN1, IGRRN1, ILIRN1,
C     CHPOINT "CENTRE" de densité, gradient et limiteur
C
C     IVN1, IGRVN1, ILIVN1,
C     CHPOINT "CENTRE" de vitesse, gradient et limiteur
C
C     IPN1, IGRPN1, ILIPN1.
C     CHPOINT "CENTRE" de pression, gradients et limiteurs
C
C     IYMA, IGRYMA, ILIYMA,
C     CHPOINT "CENTRE" de Y, gradient et limiteur
C
C     IALC, IGRALC, ILIALC,
C     CHPOINT "CENTRE" de ALPHA, gradient et limiteur
C
C SORTIES
C
C     IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF
C     MCHAMLs  definis sur le MELEME de pointeur IFACEL
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Crée le 03.12.10.
C
C************************************************************************
C
C
C ATTENTION: Cet programme marche si le MAILLAGE est convex;
C            si non il faut changer l'algoritme de calcul de
C            l'orientation des normales aux faces.
C
C            La positivité n'est pas controlle parce que c'est déjà fait
C            dans l'operateur PRIM
C
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
C
C**** Les variables
C
      INTEGER NESP, I1
     &     , ICEN, IFACE, IFACEL, INORM
     &     , IPHI, IGRPHI, ILIPHI
     &     , IRN1, IGRRN1, ILIRN1
     &     , IVN1, IGRVN1, ILIVN1
     &     , IPN1, IGRPN1, ILIPN1
     &     , IYMA, IGRYMA, ILIYMA
     &     , IALC, IGRALC, ILIALC
     &     , IPHIF, IRN1F
     &     , IVN1F, IPN1F
     &     , IYF, IALF
     &     , IGEOM, NFAC
     &     , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
     &     , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
     &     , IDIMP1, INDCEL
 
      REAL*8 XG, YG, XC, YC, XD, YD
     &     ,DXG, DYG, DXD, DYD
     &     , CNX, CNY, CTX, CTY, ORIENT
     &     , PHIG, RN1G, PN1G
     &     , UX1G, UY1G
     &     , UN1G, UT1G
     &     , PHID, RN1D, PN1D
     &     , UX1D, UY1D
     &     , UN1D, UT1D
     &     , VALCEL, DCEL, LIMCEL
      CHARACTER*(40) MESERR
      CHARACTER*(8) TYPE
      LOGICAL LOGI1
C
C**** Segments des fractions massiques gauche et droit
C
      INTEGER NS
      SEGMENT FRAMAS
         REAL*8 FRAMG(NS), FRAMD(NS)
      ENDSEGMENT
      POINTEUR ALPHA.FRAMAS
C
C**** Les Includes
C
-INC SMCOORD
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPPHI.MPOVAL,  MPGPHI.MPOVAL, MPLPHI.MPOVAL
      POINTEUR MPRN1.MPOVAL,  MPGRN1.MPOVAL, MPLRN1.MPOVAL
      POINTEUR MPVN1.MPOVAL,  MPGVN1.MPOVAL, MPLVN1.MPOVAL
      POINTEUR MPPN1.MPOVAL,  MPGPN1.MPOVAL, MPLPN1.MPOVAL
      POINTEUR MPYMA.MPOVAL,  MPGYMA.MPOVAL, MPLYMA.MPOVAL
      POINTEUR MPALC.MPOVAL,  MPGALC.MPOVAL, MPLALC.MPOVAL
      POINTEUR MPNORM.MPOVAL
-INC SMCHAML
C     Melval des cosinus directeurs
      POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
     &     MELT1X.MELVAL, MELT1Y.MELVAL
C     Melval des vitesses
      POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL
C     Melval des densités, pressions, alphas
      POINTEUR MELRN1.MELVAL
      POINTEUR MELPN1.MELVAL
      POINTEUR MELPHI.MELVAL
      POINTEUR MCHAMY.MCHAML
      POINTEUR MCHAMA.MCHAML
-INC SMLENTI
-INC SMELEME
-INC SMLMOTS
      POINTEUR MLMESP.MLMOTS
C
      LOGI1 = .FALSE.
C
C**** KRIPAD pour la correspondance global/local de centre
C
      CALL KRIPAD(ICEN,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**** Activation de CHPOINTs
C
C     phi      + grad + limiteur
C     densité  + grad + limiteur
C     vitesse  + grad + limiteur
C     pression + grad + limiteur
C     ymass    + grad + limiteur
C     alpha    + grad + limiteur
C     cosinus directeurs des normales aux surface
C
      CALL LICHT(IPHI    , MPPHI   , TYPE, IGEOM)
C     SEGACT MPPHI
      CALL LICHT(IGRPHI  , MPGPHI  , TYPE, IGEOM)
C     SEGACT MPGPHI
      CALL LICHT(ILIPHI  , MPLPHI  , TYPE, IGEOM)
C     SEGACT MPLPHI
      CALL LICHT(IRN1    , MPRN1   , TYPE, IGEOM)
C     SEGACT MPRN1
      CALL LICHT(IGRRN1  , MPGRN1  , TYPE, IGEOM)
C     SEGACT MPGRN1
      CALL LICHT(ILIRN1  , MPLRN1  , TYPE, IGEOM)
C     SEGACT MPLRN1
      CALL LICHT(IVN1    , MPVN1   , TYPE, IGEOM)
C     SEGACT MPVN1
      CALL LICHT(IGRVN1  , MPGVN1  , TYPE, IGEOM)
C     SEGACT MPGVN1
      CALL LICHT(ILIVN1  , MPLVN1  , TYPE, IGEOM)
C     SEGACT MPLVN1
      CALL LICHT(IPN1    , MPPN1   , TYPE, IGEOM)
C     SEGACT MPPN1
      CALL LICHT(IGRPN1  , MPGPN1  , TYPE, IGEOM)
C     SEGACT MPGPN1
      CALL LICHT(ILIPN1  , MPLPN1  , TYPE, IGEOM)
C     SEGACT MPLPN1
      IF (NESP .GE. 1)THEN
         CALL LICHT(IYMA    , MPYMA   , TYPE, IGEOM)
C        SEGACT MPYMA
         CALL LICHT(IGRYMA  , MPGYMA  , TYPE, IGEOM)
C        SEGACT MPGYMA
         CALL LICHT(ILIYMA  , MPLYMA  , TYPE, IGEOM)
C        SEGACT MPLYMA
         CALL LICHT(IALC    , MPALC   , TYPE, IGEOM)
C        SEGACT MPALC
         CALL LICHT(IGRALC  , MPGALC  , TYPE, IGEOM)
C        SEGACT MPGALC
         CALL LICHT(ILIALC  , MPLALC  , TYPE, IGEOM)
C        SEGACT MPLALC
      ENDIF
C
C**** Le cosinus directeurs
C
      CALL LICHT(INORM  , MPNORM  , TYPE, IGEOM)
C     SEGACT MPNORM
C
C**** Les MPOVAL sont déjà activés i.e.:
C
C
C**** Le MELEME FACEL
C
      IPT1 = IFACEL
      IPT2 = IFACE
      SEGACT IPT1
      SEGACT IPT2
      NFAC = IPT1.NUM(/2)
C
C**** Creation de MCHAMLs contenant les etats gauche et droite,
C
C     i.e.:
C
C     vitesse + cosinus directors du repere local
C     alpha
C     densité
C     pression
C
C**********************************************************
C**** Cosinus directors du repere local et vitesse ********
C**********************************************************
C
C     Les cosinus directeurs
C
      N1 = 2
      N3 = 6
      L1 = 28
      SEGINI MCHEL1
      IVN1F = MCHEL1
      MCHEL1.TITCHE = 'U  '
      MCHEL1.IMACHE(1) = IFACE
      MCHEL1.IMACHE(2) = IFACEL
      MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
      MCHEL1.CONCHE(2) = ' U in (n,t)     '
*      MCHEL1.NOPHAS(1) = '        '
*      MCHEL1.NOPHAS(2) = '        '
C
C**** Valeurs des cosinus definies par respect au repair global, i.e.
C
      MCHEL1.INFCHE(1,1) = 2
      MCHEL1.INFCHE(1,3) = NIFOUR
      MCHEL1.INFCHE(1,4) = 0
      MCHEL1.INFCHE(1,5) = 0
      MCHEL1.INFCHE(1,6) = 0
      MCHEL1.IFOCHE = IFOUR
C
C**** Valeurs de vitesse definies par respect au repair local, i.e.
C
      MCHEL1.INFCHE(2,1) = 1
      MCHEL1.INFCHE(2,3) = NIFOUR
      MCHEL1.INFCHE(2,4) = 0
      MCHEL1.INFCHE(2,5) = 0
      MCHEL1.INFCHE(2,6) = 0
C
C**** Le cosinus directeurs
C
      N1PTEL = 1
      N1EL = NFAC
      N2PTEL = 0
      N2EL =   0
C
C**** MCHAML a N2 composantes:
C
C     cosinus directeurs du repere local (n,t1)
C
C     IDIM = 2 -> 4 composantes
C
      N2 = 4
      SEGINI MCHAM1
      MCHEL1.ICHAML(1) = MCHAM1
      MCHAM1.NOMCHE(1) = 'NX      '
      MCHAM1.NOMCHE(2) = 'NY      '
      MCHAM1.NOMCHE(3) = 'TX      '
      MCHAM1.NOMCHE(4) = 'TY      '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      MCHAM1.TYPCHE(2) = 'REAL*8          '
      MCHAM1.TYPCHE(3) = 'REAL*8          '
      MCHAM1.TYPCHE(4) = 'REAL*8          '
      SEGINI MELVNX
      SEGINI MELVNY
      SEGINI MELT1X
      SEGINI MELT1Y
      MCHAM1.IELVAL(1) = MELVNX
      MCHAM1.IELVAL(2) = MELVNY
      MCHAM1.IELVAL(3) = MELT1X
      MCHAM1.IELVAL(4) = MELT1Y
      SEGDES MCHAM1
C
C**** Vitesse
C
      N1EL = NFAC
      N1PTEL = 3
      N2EL = 0
      N2PTEL = 0
C
C**** MCHAML a N2 composantes:
C
C     IDIM = 2 -> 2 composantes
C
      N2 = 2
      SEGINI MCHAM1
      MCHEL1.ICHAML(2) = MCHAM1
      MCHAM1.NOMCHE(1) = 'UN      '
      MCHAM1.NOMCHE(2) = 'UT      '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      MCHAM1.TYPCHE(2) = 'REAL*8          '
      SEGINI MEVUN1
      SEGINI MEVUT1
      MCHAM1.IELVAL(1) = MEVUN1
      MCHAM1.IELVAL(2) = MEVUT1
      SEGDES MCHAM1
C
C**********************************************************
C**** PHI1                                         ********
C**********************************************************
C
C**** PHI1
C
      N1 = 1
      N3 = 6
      L1 = 15
      SEGINI MCHEL2
      IPHIF = MCHEL2
      MCHEL2.IMACHE(1) = IFACEL
      MCHEL2.TITCHE = 'PHI            '
      MCHEL2.CONCHE(1) = '                '
*      MCHEL2.NOPHAS(1) = '        '
C
C**** Valeurs independente du repére, i.e.
C
      MCHEL2.INFCHE(1,1) = 0
      MCHEL2.INFCHE(1,3) = NIFOUR
      MCHEL2.INFCHE(1,4) = 0
      MCHEL2.INFCHE(1,5) = 0
      MCHEL2.INFCHE(1,6) = 0
      MCHEL2.IFOCHE = IFOUR
      N2 = 1
      SEGINI MCHAM1
      MCHEL2.ICHAML(1) = MCHAM1
C     We cannot deseactivate MCHEL2 = IPHIF now since we
C     use it after...
      MCHAM1.NOMCHE(1) = 'SCAL    '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      SEGINI MELPHI
      MCHAM1.IELVAL(1) = MELPHI
      SEGDES MCHAM1
C
C**********************************************************
C**** IRN1F and IRN2F                              ********
C**********************************************************
C
      MCHEL1 = IPHIF
      SEGINI, MCHEL2 = MCHEL1
      IRN1F = MCHEL2
      MCHEL2.TITCHE = 'RHO1         '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MELRN1
      MCHAM2.IELVAL(1) = MELRN1
      SEGDES MCHAM2
C
C
C
C**********************************************************
C**** IPN1F
C**********************************************************
C
      MCHEL1 = IPHIF
      SEGINI, MCHEL2 = MCHEL1
      IPN1F = MCHEL2
      MCHEL2.TITCHE = 'P1           '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGDES MCHEL1
C     We desactivate MCHEL1 = IPHIF now !
      SEGINI MELPN1
      MCHAM2.IELVAL(1) = MELPN1
      SEGDES MCHAM2
C
C      write(*,*) 'Qui ci arrivo 1...'
      IF (NESP .GE. 1) THEN
C
         SEGACT MLMESP
C
C******* YF
C
         NS = NESP
         SEGINI FRAMAS
         MCHEL1 = IRN1F
         SEGINI, MCHEL2 = MCHEL1
         IYF = MCHEL2
         MCHEL2.TITCHE = 'Y            '
         N2 = NESP
         SEGINI MCHAMY
         MCHEL2.ICHAML(1) = MCHAMY
         SEGDES MCHEL2
         N1EL = NFAC
         N1PTEL = 3
         N2EL = 0
         N2PTEL = 0
         DO I1 = 1, NESP
            SEGINI MELVA1
            MCHAMY.IELVAL(I1) = MELVA1
            MCHAMY.NOMCHE(I1) = MLMESP.MOTS(I1)
            MCHAMY.TYPCHE(I1) = 'REAL*8          '
         ENDDO
C
C******* IALF
C
         NS = NESP
         SEGINI ALPHA
         MCHEL1 = IRN1F
         SEGINI, MCHEL2 = MCHEL1
         IALF = MCHEL2
         MCHEL2.TITCHE = 'ALPHA        '
         N2 = NESP
         SEGINI MCHAMA
         MCHEL2.ICHAML(1) = MCHAMA
         SEGDES MCHEL2
         N1EL = NFAC
         N1PTEL = 3
         N2EL = 0
         N2PTEL = 0
         DO I1 = 1, NESP
            SEGINI MELVA1
            MCHAMA.IELVAL(I1) = MELVA1
            MCHAMA.NOMCHE(I1) = MLMESP.MOTS(I1)
            MCHAMA.TYPCHE(I1) = 'REAL*8          '
         ENDDO
C
         SEGDES MLMESP
      ENDIF
C
C      write(*,*) 'Qui ci arrivo 2...'
C
C
C**********************************************************
C**** Boucle sur le faces                         *********
C**********************************************************
C
      IDIMP1 = IDIM + 1
      SEGACT,MCOORD
      DO NLCF = 1, NFAC
C
C******* NLCF  = numero local du centre de face
C        NGCF  = numero global 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 = IPT1.NUM(1,NLCF)
         NGCF  = IPT1.NUM(2,NLCF)
         NGCED = IPT1.NUM(3,NLCF)
         NLCEG = MLENT1.LECT(NGCEG)
         NLCED = MLENT1.LECT(NGCED)
C
C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
C
         NGCF1 = IPT2.NUM(1,NLCF)
         IF( NGCF1 .NE. NGCF) THEN
            MESERR(1:40) = 'PRET, subroutine pre611.eso             '
            WRITE(IOIMP,*) MESERR
            CALL ERREUR(5)
            GOTO 9999
         ENDIF
C
C******* Cosinus directeurs des NORMALES aux faces
C
C        On impose que les normales sont direct "Gauche" -> "Centre"
C
         INDCEL = (NGCEG-1)*IDIMP1
         XG = XCOOR(INDCEL+1)
         YG = XCOOR(INDCEL+2)
         INDCEL = (NGCF-1)*IDIMP1
         XC = XCOOR(INDCEL + 1)
         YC = XCOOR(INDCEL + 2)
         INDCEL = (NGCED-1)*IDIMP1
         XD = XCOOR(INDCEL+1)
         YD = XCOOR(INDCEL+2)
         DXG = XC - XG
         DYG = YC - YG
         DXD = XC - XD
         DYD = YC - YD
C
C******* On calcule le sign du pruduit scalare
C        (Normales de Castem) * (vecteur "gauche" -> "centre")
C
         CNX = MPNORM.VPOCHA(NLCF,1)
         CNY = MPNORM.VPOCHA(NLCF,2)
         ORIENT = CNX * DXG + CNY * DYG
         ORIENT = SIGN(1.0D0,ORIENT)
         IF(ORIENT .NE. 1.0D0)THEN
            MESERR(1:30)=
     &           'PRET , subroutine pre611.eso. '
            GOTO 9999
         ENDIF
         CNX = CNX * ORIENT
         CNY = CNY * ORIENT
C
C******* Cosinus directeurs de tangent 2D
C
         CTX = -1.0D0 * CNY
         CTY = CNX
C
C******* Les autres MELVALs
C
C
C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0...
C
C
C******* Etat gauche
C
C        PHI
C
         VALCEL = MPPHI.VPOCHA(NLCEG, 1)
         LIMCEL = MPLPHI.VPOCHA(NLCEG, 1)
         DCEL = (MPGPHI.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGPHI.VPOCHA(NLCEG, 2) * DYG)
         PHIG = VALCEL + (LIMCEL * DCEL)
C         write(*,*) valcel, limcel, dcel
C
C
C        RN
C
         VALCEL = MPRN1.VPOCHA(NLCEG, 1)
         LIMCEL = MPLRN1.VPOCHA(NLCEG, 1)
         DCEL = (MPGRN1.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGRN1.VPOCHA(NLCEG, 2) * DYG)
         RN1G = VALCEL + (LIMCEL * DCEL)
C
C
C        PN
C
         VALCEL = MPPN1.VPOCHA(NLCEG, 1)
         LIMCEL = MPLPN1.VPOCHA(NLCEG, 1)
         DCEL = (MPGPN1.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGPN1.VPOCHA(NLCEG, 2) * DYG)
         PN1G = VALCEL + (LIMCEL * DCEL)
C
C        VN
C
         VALCEL = MPVN1.VPOCHA(NLCEG, 1)
         LIMCEL = MPLVN1.VPOCHA(NLCEG, 1)
         DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG +
     &        MPGVN1.VPOCHA(NLCEG, 2)*DYG
         UX1G = VALCEL + (LIMCEL * DCEL)
C
         VALCEL = MPVN1.VPOCHA(NLCEG, 2)
         LIMCEL = MPLVN1.VPOCHA(NLCEG, 2)
         DCEL = MPGVN1.VPOCHA(NLCEG, 3)*DXG +
     &        MPGVN1.VPOCHA(NLCEG, 4)*DYG
         UY1G = VALCEL + (LIMCEL * DCEL)
C
C        YN
C
         DO I1 = 1, NESP
            INDCEL = 2 * I1 - 1
            VALCEL = MPYMA.VPOCHA(NLCEG,I1)
            DCEL = MPGYMA.VPOCHA(NLCEG, INDCEL)*DXG +
     &           MPGYMA.VPOCHA(NLCEG,INDCEL + 1 )*DYG
            LIMCEL = MPLYMA.VPOCHA(NLCEG,I1)
            FRAMAS.FRAMG(I1) = VALCEL + (LIMCEL * DCEL)
         ENDDO
C
C        ALPHAN
C
         DO I1 = 1, NESP
            INDCEL = 2 * I1 - 1
            VALCEL = MPALC.VPOCHA(NLCEG,I1)
            DCEL = MPGALC.VPOCHA(NLCEG, INDCEL)*DXG +
     &           MPGALC.VPOCHA(NLCEG,INDCEL + 1 )*DYG
            LIMCEL = MPLALC.VPOCHA(NLCEG,I1)
            ALPHA.FRAMG(I1) =  VALCEL + (LIMCEL * DCEL)
         ENDDO
C
C
C******* Si l'on fait pas de prediction, ce n'est pas necessaire de
C        controller la positivite' de la pression et de la densité; elle
C        est déjà garantie par la proprieté LED de limiteur.
C        If we want to check it, just uncomment LOGI1.
C
C         LOGI1 = (RN1G .LT. 0.0D0) .OR.
C     &        (PN1G .LT. 0.0D0)
C
         IF ( NGCEG .EQ. NGCED) THEN
C
C********** Cas mur
C
            IF(LOGI1)THEN
C
C********** Premier ordre en espace local
C
               PHIG = MPPHI.VPOCHA(NLCEG,1)
               RN1G = MPRN1.VPOCHA(NLCEG,1)
               PN1G = MPPN1.VPOCHA(NLCEG,1)
               UX1G = MPVN1.VPOCHA(NLCEG,1)
               UY1G = MPVN1.VPOCHA(NLCEG,2)
               DO I1 = 1, NESP
                  FRAMAS.FRAMG(I1) = MPYMA.VPOCHA(NLCEG,I1)
               ENDDO
               DO I1 = 1, NESP
                  ALPHA.FRAMG(I1) = MPALC.VPOCHA(NLCEG,I1)
               ENDDO
            ENDIF
C
            UN1G = UX1G * CNX + UY1G * CNY
            UT1G = UX1G * CTX + UY1G * CTY
C
C********** Son etat droite
C
            PHID = PHIG
            RN1D = RN1G
            PN1D = PN1G
            UN1D = -1.0D0 * UN1G
            UT1D = UT1G
            DO I1 = 1, NESP
               FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
            ENDDO
            DO I1 = 1, NESP
               ALPHA.FRAMD(I1) = ALPHA.FRAMG(I1)
            ENDDO
C
C********** Fin cas mur
C
         ELSE
            VALCEL = MPPHI.VPOCHA(NLCED, 1)
            LIMCEL = MPLPHI.VPOCHA(NLCED, 1)
            DCEL = (MPGPHI.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGPHI.VPOCHA(NLCED, 2) * DYD)
            PHID = VALCEL + (LIMCEL * DCEL)
C
C           RN
C
            VALCEL = MPRN1.VPOCHA(NLCED, 1)
            LIMCEL = MPLRN1.VPOCHA(NLCED, 1)
            DCEL = (MPGRN1.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGRN1.VPOCHA(NLCED, 2) * DYD)
            RN1D = VALCEL + (LIMCEL * DCEL)
C
C           PN
C
            VALCEL = MPPN1.VPOCHA(NLCED, 1)
            LIMCEL = MPLPN1.VPOCHA(NLCED, 1)
            DCEL = (MPGPN1.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGPN1.VPOCHA(NLCED, 2) * DYD)
            PN1D = VALCEL + (LIMCEL * DCEL)
C
C           VN
C
            VALCEL = MPVN1.VPOCHA(NLCED, 1)
            LIMCEL = MPLVN1.VPOCHA(NLCED, 1)
            DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD +
     &             MPGVN1.VPOCHA(NLCED, 2)*DYD
            UX1D = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN1.VPOCHA(NLCED, 2)
            LIMCEL = MPLVN1.VPOCHA(NLCED, 2)
            DCEL = MPGVN1.VPOCHA(NLCED, 3)*DXD +
     &             MPGVN1.VPOCHA(NLCED, 4)*DYD
            UY1D = VALCEL + LIMCEL * DCEL
C
C        YN
C
            DO I1 = 1, NESP
               INDCEL = 2 * I1 - 1
               VALCEL = MPYMA.VPOCHA(NLCED,I1)
               DCEL = MPGYMA.VPOCHA(NLCED, INDCEL)*DXD +
     &              MPGYMA.VPOCHA(NLCED,INDCEL + 1 )*DYD
               LIMCEL = MPLYMA.VPOCHA(NLCED,I1)
               FRAMAS.FRAMD(I1) = VALCEL + (LIMCEL * DCEL)
            ENDDO
C
C        ALPHAN
C
            DO I1 = 1, NESP
               INDCEL = 2 * I1 - 1
               VALCEL = MPALC.VPOCHA(NLCED,I1)
               DCEL = MPGALC.VPOCHA(NLCED, INDCEL)*DXD +
     &              MPGALC.VPOCHA(NLCED,INDCEL + 1 )*DYD
               LIMCEL = MPLALC.VPOCHA(NLCED,I1)
               ALPHA.FRAMD(I1) =  VALCEL + (LIMCEL * DCEL)
            ENDDO
 
C
C
C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
C           controller la positivite' de la pression et de la densité; elle
C           est déjà garantie par la proprieté LED de limiteur.
C           If we want to check it, just uncomment LOGI1.
C
C            LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0)
C     $           .OR.(PN1D .LT. 0.0D0)
C
            IF(LOGI1)THEN
C
C************* Premier ordre en espace local
C
               PHIG = MPPHI.VPOCHA(NLCEG,1)
               RN1G = MPRN1.VPOCHA(NLCEG,1)
               PN1G = MPPN1.VPOCHA(NLCEG,1)
               UX1G = MPVN1.VPOCHA(NLCEG,1)
               UY1G = MPVN1.VPOCHA(NLCEG,2)
               DO I1 = 1, NESP
                  FRAMAS.FRAMG(I1) = MPYMA.VPOCHA(NLCEG,I1)
               ENDDO
               DO I1 = 1, NESP
                  ALPHA.FRAMG(I1) = MPALC.VPOCHA(NLCEG,I1)
               ENDDO
C
               PHID = MPPHI.VPOCHA(NLCED,1)
               RN1D = MPRN1.VPOCHA(NLCED,1)
               PN1D = MPPN1.VPOCHA(NLCED,1)
               UX1D = MPVN1.VPOCHA(NLCED,1)
               UY1D = MPVN1.VPOCHA(NLCED,2)
               DO I1 = 1, NESP
                  FRAMAS.FRAMD(I1) = MPYMA.VPOCHA(NLCED,I1)
               ENDDO
               DO I1 = 1, NESP
                  ALPHA.FRAMD(I1) = MPALC.VPOCHA(NLCED,I1)
               ENDDO
            ENDIF
C
            UN1G = UX1G * CNX + UY1G * CNY
            UT1G = UX1G * CTX + UY1G * CTY
C
            UN1D = UX1D * CNX + UY1D * CNY
            UT1D = UX1D * CTX + UY1D * CTY
C
         ENDIF
C
C
C******** Les MELVALs
C
         MELPHI.VELCHE(1,NLCF) = PHIG
         MELPHI.VELCHE(3,NLCF) = PHID
C
         MELRN1.VELCHE(1,NLCF) = RN1G
         MELRN1.VELCHE(3,NLCF) = RN1D
C
         MELPN1.VELCHE(1,NLCF) = PN1G
         MELPN1.VELCHE(3,NLCF) = PN1D
C
         MEVUN1.VELCHE(1,NLCF) = UN1G
         MEVUN1.VELCHE(3,NLCF) = UN1D
         MEVUT1.VELCHE(1,NLCF) = UT1G
         MEVUT1.VELCHE(3,NLCF) = UT1D
         MELVNX.VELCHE(1,NLCF) = CNX
         MELVNY.VELCHE(1,NLCF) = CNY
         MELT1X.VELCHE(1,NLCF) = CTX
         MELT1Y.VELCHE(1,NLCF) = CTY
C
         DO I1 = 1, NESP
            MELVA1 = MCHAMY.IELVAL(I1)
            MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1)
            MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1)
         ENDDO
C
         DO I1 = 1, NESP
            MELVA1 = MCHAMA.IELVAL(I1)
            MELVA1.VELCHE(1,NLCF) = ALPHA.FRAMG(I1)
            MELVA1.VELCHE(3,NLCF) = ALPHA.FRAMD(I1)
         ENDDO
C
      ENDDO
C
C**** Desactivation des SEGMENTs
C
      SEGDES IPT1
      SEGDES IPT2
C
C     MPOVALs
C
      SEGDES MPNORM
C
      SEGDES MPPHI
      SEGDES MPGPHI
      SEGDES MPLPHI
C
      SEGDES MPRN1
      SEGDES MPGRN1
      SEGDES MPLRN1
C
      SEGDES MPPN1
      SEGDES MPGPN1
      SEGDES MPLPN1
C
      SEGDES MPVN1
      SEGDES MPGVN1
      SEGDES MPLVN1
C
C     MELVALs
C
      SEGDES MELVNX
      SEGDES MELVNY
      SEGDES MELT1X
      SEGDES MELT1Y
      SEGDES MEVUN1
      SEGDES MEVUT1
C
      SEGDES MELPHI
C
      SEGDES MELRN1
C
      SEGDES MELPN1
C
      IF (NESP .GE. 1)THEN
         SEGDES MPYMA
         SEGDES MPGYMA
         SEGDES MPLYMA
         SEGDES MPALC
         SEGDES MPGALC
         SEGDES MPLALC
         DO I1 = 1, NESP
            MELVA1 = MCHAMY.IELVAL(I1)
            SEGDES MELVA1
            MELVA1 = MCHAMA.IELVAL(I1)
            SEGDES MELVA1
         ENDDO
         SEGDES MCHAMA
         SEGDES MCHAMY
         SEGSUP FRAMAS
         SEGSUP ALPHA
      ENDIF
C
C**** Destruction du MELNTI correspondance local/global
C
      SEGSUP MLENT1
C
 9999 CONTINUE
C
      RETURN
      END