C PRE22F    SOURCE    OF166741  24/10/03    21:15:32     12022          
      SUBROUTINE PRE22F(ICEN,IFACE,IFACEL,INORM,
     &                   IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
     &                   IALPF, IUVF, IULF, IPF, ITVF, ITLF,
     &                   IRVF, IRLF,
     &                   LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE22F
C
C DESCRIPTION       :  Voir PRE12F
C
C                      Two Dimensions
C
C                      Two Fluid Flow, 1st order in time and space
C
C                      Creations des objets MCHAML IALPF, IUVF, IULF,
C                      IPF, ITVF, ITLF, IRVF, IRLF
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C                      Modified for two-fluid flow by
C                      Jose R. Garcia-Cascales
C
C************************************************************************
C
C APPELES (Outils)  :  KRIPAD, LICHT
C
C APPELES (Calcul)  :  AUCUN
C
C************************************************************************
C
C ENTREES
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) Pointeurs des  CHPOINTs
C
C     IALP   : CHPOINT "CENTRE" containing void fraction
C
C     IUVC    : CHPOINT "CENTRE" containing UVX & UVY
C
C     IULC    : CHPOINT "CENTRE" containing ULX & ULY
C
C     IPC     : CHPOINT "CENTRE" containing P
C
C     ITV     : CHPOINT "CENTRE" containing TV
C
C     ITL     : CHPOINT "CENTRE" containing TL
C
C     IRVC    : CHPOINT "CENTRE" containing RV
C
C     IRLC    : CHPOINT "CENTRE" containing RL
C
C SORTIES
C
C     IALPF      : MCHAML defined en la MELEME of pointers
C                   IFACEL, it contains the void fraction
C                   (a gauche et a droite de chaque face).
C                   Only one component  ('SCAL')
C
C     IUVF        : MCHAML  "FACEL"  vapour velocity and the
C                   director cosines (n,t) in the corresponding face;
C                   in the 2D case 6 composantes:
C                   'UVN' = normal velocity,
C                   'UVT' = tangent velocity,
C                   'UVV' = tangent velocity,
C                   these two velocities are defined in a local
C                   reference framework defined over the MELEME
C                   of pointers IFACE
C                   'NX' = n.x
C                   'NY' = n.y
C                   'TX' = t.x
C                   'TY' = t.y
C
C     IULF        : MCHAML  "FACEL"  liquid velocity
C                   in the 2D case 2 composantes:
C                   'ULN' = normal velocity,
C                   'ULT' = tangent velocity,
C
C     IPF         : MCHAML "FACEL" pressure
C                   Only one component ('SCAL')
C
C     ITVF        : MCHAML "FACEL"  vapour temperature
C                   Only one component ('SCAL')
C
C     ITVL        : MCHAML "FACEL"  liquid temperature
C                   Only one component ('SCAL')
C
C     IRVF        : MCHAML "FACEL"  vapour density
C                   Only one component ('SCAL')
C
C     IRLF        : MCHAML "FACEL"  liquid temperature
C                   Only one component ('SCAL')
C
C     LOGAN   : anomalie detectee (changement de la convention dans
C               la table domaine)
C
C     LOGNEG  : (LOGICAL): si .TRUE. une pression ou une densité
C               negative a été detectée -> en interactif le
C               programme s'arrete  en GIBIANE
C               (erreur stocké en MESERR et VALER)
C
C     LOGBOR  : (LOGICAL): si .TRUE. un gamma a ete detecte
C               dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
C               en VAL1 et en VAL2 on stocke 1.0 et 3.0)
C
C     MESERR
C     VALER
C     VAL1,
C     VAL2    : pour les messages d'erreur
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 11.6.98.(Adapted to two phase flow 26th
C                                 February 2002)
C
C************************************************************************
C
C
C ATTENTION: Cet programme marche que si le MAILLAGE est convex;
C            si non il faut changer l'argoritme de calcul de
C            l'orientation des normales aux faces.
C
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

C**** Les variables
C
      INTEGER ICEN, IFACE, IFACEL,
     &         IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, INORM,
     &         IALPF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF,
     &         IGEOM, NFAC,
     &         N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1,
     &         NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
      REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, DXG, DYG,
     &       CNX, CNY, CTX, CTY, ORIENT,
     &       AG, UVXG, UVYG, UVNG, UVTG, ULXG, ULYG, ULNG, ULTG,
     &       PG, TVG, TLG, RVG, RLG,
     &       AD, UVXD, UVYD, UVND, UVTD, ULXD, ULYD, ULND, ULTD,
     &       PD, TVD, TLD, RVD, RLD
      CHARACTER*(40) MESERR
      CHARACTER*(8) TYPE
      LOGICAL LOGAN,LOGNEG, LOGBOR
C
C**** Les Includes
C
-INC SMCOORD

-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPALP.MPOVAL, MPUVC.MPOVAL, MPULC.MPOVAL,
     &         MPPC.MPOVAL, MPTVC.MPOVAL, MPTLC.MPOVAL,
     &         MPRVC.MPOVAL, MPRLC.MPOVAL, MPNORM.MPOVAL
-INC SMCHAML
      POINTEUR MLALP.MELVAL, MLP.MELVAL,
     &         MLTV.MELVAL, MLTL.MELVAL,
     &         MLRV.MELVAL, MLRL.MELVAL
      POINTEUR MLUVN.MELVAL, MLUVT.MELVAL,
     &         MLULN.MELVAL, MLULT.MELVAL,
     &         MLVNX.MELVAL, MLVNY.MELVAL, MLVTX.MELVAL, MLVTY.MELVAL,
     &         MLLNX.MELVAL, MLLNY.MELVAL, MLLTX.MELVAL, MLLTY.MELVAL
-INC SMLENTI
-INC SMELEME
C
C**** Initialisation des parametres d'erreur déjà faite, i.e.
C
C     LOGNEG  = .FALSE.
C     LOGBOR  = .FALSE.
C     MESERR = '                                        '
C     MOTERR(1:40) = MESERR(1:40)
C     VALER = 0.0D0
C     VAL1 = 0.0D0
C     VAL2 = 0.0D0
C
C
C**** KRIPAD pour la correspondance global/local de centre
C
      CALL KRIPAD(ICEN,MLENT1)
C
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     SEGINI MLENTI1
C
C**** Activation de CHPOINTs
C
C     void fraction
C     vapour velocities
C     liquid velocities
C     pressure
C     vapour temperature
C     liquid temperature
C     vapour density
C     liquid density
C
C     cosinus directeurs des normales aux surface
C
      CALL LICHT(IALP, MPALP, TYPE, IGEOM)
      CALL LICHT(IUVC, MPUVC, TYPE, IGEOM)
      CALL LICHT(IULC, MPULC, TYPE, IGEOM)
      CALL LICHT(IPC , MPPC , TYPE, IGEOM)
      CALL LICHT(ITVC, MPTVC, TYPE, IGEOM)
      CALL LICHT(ITLC, MPTLC, TYPE, IGEOM)
      CALL LICHT(IRVC, MPRVC, TYPE, IGEOM)
      CALL LICHT(IRLC, MPRLC, TYPE, IGEOM)
      CALL LICHT(INORM, MPNORM, TYPE, IGEOM)
C
C     SEGACT MPALP
C     SEGACT MPUVC
C     SEGACT MPULC
C     SEGACT MPPC
C     SEGACT MPTVC
C     SEGACT MPTLC
C     SEGACT MPRVC
C     SEGACT MPRLC
C     SEGACT MPNORM
C
C**** MPOVA1 - MPOVA5 sont déjà activés i.e.:
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     densité
C     pression
C     gamma

C
C**** Cosinus directors du repere local et vitesse
C
C     Les cosinus directeurs
C
C     VAPOUR PHASE

      N1 = 2
      N3 = 6
      L1 = 28
      SEGINI MCHEL1
      IUVF = MCHEL1
      MCHEL1.TITCHE = 'UV '
      MCHEL1.IMACHE(1) = IFACE
      MCHEL1.IMACHE(2) = IFACEL
      MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
      MCHEL1.CONCHE(2) = ' UV in (n,t)    '
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) = 1
      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) = 1
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) = 'NVX     '
      MCHAM1.NOMCHE(2) = 'NVY     '
      MCHAM1.NOMCHE(3) = 'TVX     '
      MCHAM1.NOMCHE(4) = 'TVY     '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      MCHAM1.TYPCHE(2) = 'REAL*8          '
      MCHAM1.TYPCHE(3) = 'REAL*8          '
      MCHAM1.TYPCHE(4) = 'REAL*8          '
      SEGINI MLVNX
      SEGINI MLVNY
      SEGINI MLVTX
      SEGINI MLVTY
      MCHAM1.IELVAL(1) = MLVNX
      MCHAM1.IELVAL(2) = MLVNY
      MCHAM1.IELVAL(3) = MLVTX
      MCHAM1.IELVAL(4) = MLVTY
      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
      SEGDES MCHEL1
      MCHAM1.NOMCHE(1) = 'UVN     '
      MCHAM1.NOMCHE(2) = 'UVT     '
      MCHAM1.TYPCHE(1) = 'REAL*8         '
      MCHAM1.TYPCHE(2) = 'REAL*8         '
      SEGINI MLUVN
      SEGINI MLUVT
      MCHAM1.IELVAL(1) = MLUVN
      MCHAM1.IELVAL(2) = MLUVT
      SEGDES MCHAM1
C
C**** Cosinus directors du repere local et vitesse
C
C     Les cosinus directeurs
C
C     LIQUID PHASE

      N1 = 2
      N3 = 6
      L1 = 28
      SEGINI MCHEL1
      IULF = MCHEL1
      MCHEL1.TITCHE = 'UL '
      MCHEL1.IMACHE(1) = IFACE
      MCHEL1.IMACHE(2) = IFACEL
      MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
      MCHEL1.CONCHE(2) = ' UL in (n,t)    '
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) = 1
      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) = 1
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) = 'NLX     '
      MCHAM1.NOMCHE(2) = 'NLY     '
      MCHAM1.NOMCHE(3) = 'TLX     '
      MCHAM1.NOMCHE(4) = 'TLY     '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      MCHAM1.TYPCHE(2) = 'REAL*8          '
      MCHAM1.TYPCHE(3) = 'REAL*8          '
      MCHAM1.TYPCHE(4) = 'REAL*8          '
      SEGINI MLLNX
      SEGINI MLLNY
      SEGINI MLLTX
      SEGINI MLLTY
      MCHAM1.IELVAL(1) = MLLNX
      MCHAM1.IELVAL(2) = MLLNY
      MCHAM1.IELVAL(3) = MLLTX
      MCHAM1.IELVAL(4) = MLLTY
      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
      SEGDES MCHEL1
      MCHAM1.NOMCHE(1) = 'ULN     '
      MCHAM1.NOMCHE(2) = 'ULT     '
      MCHAM1.TYPCHE(1) = 'REAL*8         '
      MCHAM1.TYPCHE(2) = 'REAL*8         '
      SEGINI MLULN
      SEGINI MLULT
      MCHAM1.IELVAL(1) = MLULN
      MCHAM1.IELVAL(2) = MLULT
      SEGDES MCHAM1
C
C**** Void fraction
C
      N1 = 1
      N3 = 6
      L1 = 15
      SEGINI MCHEL2
      IALPF = MCHEL2
      MCHEL2.IMACHE(1) = IFACEL
      MCHEL2.TITCHE = 'ALPHA           '
      MCHEL2.CONCHE(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) = 1
      MCHEL2.IFOCHE = IFOUR
      N2 = 1
      SEGINI MCHAM1
      MCHEL2.ICHAML(1) = MCHAM1
      SEGDES MCHEL2
      MCHAM1.NOMCHE(1) = 'SCAL    '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      SEGINI MLALP
      MCHAM1.IELVAL(1) = MLALP
      SEGDES MCHAM1
C
C**** Pressure
C
      MCHEL1 = IALPF
      SEGINI, MCHEL2 = MCHEL1
      IPF = MCHEL2
      MCHEL2.TITCHE = 'P            '
C
C**** MCHAM1 = MCHAML de la alpha
C
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MLP
      MCHAM2.IELVAL(1) = MLP
      SEGDES MCHAM2
C
C**** Vapour temperature
C
      MCHEL1 = IALPF
      SEGINI, MCHEL2 = MCHEL1
      ITVF = MCHEL2
      MCHEL2.TITCHE = 'TV             '
C
C**** MCHAM1 = MCHAML de la alpha
C
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MLTV
      MCHAM2.IELVAL(1) = MLTV
      SEGDES MCHAM2
C
C**** Liquid temperature
C
      MCHEL1 = IALPF
      SEGINI, MCHEL2 = MCHEL1
      ITLF = MCHEL2
      MCHEL2.TITCHE = 'TL             '
C
C**** MCHAM1 = MCHAML de la alpha
C
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MLTL
      MCHAM2.IELVAL(1) = MLTL
      SEGDES MCHAM2
C
C**** Vapour density
C
      MCHEL1 = IALPF
      SEGINI, MCHEL2 = MCHEL1
      IRVF = MCHEL2
      MCHEL2.TITCHE = 'RV             '
C
C**** MCHAM1 = MCHAML de la alpha
C
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MLRV
      MCHAM2.IELVAL(1) = MLRV
      SEGDES MCHAM2
C
C**** Liquid density
C
      MCHEL1 = IALPF
      SEGINI, MCHEL2 = MCHEL1
      IRLF = MCHEL2
      MCHEL2.TITCHE = 'RL             '
C
C**** MCHAM1 = MCHAML de la alpha
C
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MLRL
      MCHAM2.IELVAL(1) = MLRL
      SEGDES MCHAM2

C
C**** Recapitulatif: les MELVALs et les MPOVALs actives
C
C     MLVNX, MLVNY,
C     MLVTX, MLVTY,
C
C     MLLNX, MLLNY,
C     MLLTX, MLLTY
C
C     MLUVN, MLUVT -> vapour velocities
C
C     MLULN, MLULT -> liquid velocities
C
C     MLALP  -> void fraction
C
C     MLP     -> pressure
C
C     MLTV    -> vapour temperature
C
C     MLTL    -> liquid temperature
C
C     MLRV    -> vapour density
C
C     MLRL    -> liquid density
C****
C     MPALP   -> void fraction
C
C     MPUVC   -> vapour velocity
C
C     MPULC   -> liquid velocity
C
C     MPPC    -> pressure
C
C     MPTVC   -> vapour temperature
C
C     MPTLC   -> liquid temperature
C
C     MPRVC   -> vapour density
C
C     MPRLC   -> liquid density
C
C     MPNORM  -> normales aux faces
C
C**** Boucle sur le faces
C
      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
            LOGAN = .TRUE.
            MESERR(1:40) = 'PRET, subroutine pre111.eso             '
            GOTO 9999
         ENDIF
C
C******* Cosinus directeurs des NORMALES aux faces
C
C        On impose que les normales sont direct "Gauche" -> "Centre"
C
         XG = XCOOR((NGCEG-1)*(IDIM+1)+1)
         YG = XCOOR((NGCEG-1)*(IDIM+1)+2)
         XC = XCOOR((NGCF-1)*(IDIM+1)+1)
         YC = XCOOR((NGCF-1)*(IDIM+1)+2)
         DXG = XC - XG
         DYG = YC - YG

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
            LOGAN = .TRUE.
            MESERR(1:30)=
     &           'PRET , subroutine pre111.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
C******* Les autres MELVALs
C
C
C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
C              GAMMA \in (1,3)
C              Si non il faut le faire, en utlisant LOGBOR,
C              LOGNEG, VALER, VAL1, VAL2
C
C
C
C******* NGCEG = NGCED -> Mur
C

         IF( NGCEG .EQ. NGCED)THEN
            AG   = MPALP.VPOCHA(NLCEG, 1)
            PG   = MPPC.VPOCHA(NLCEG, 1)
            TVG  = MPTVC.VPOCHA(NLCEG, 1)
            TLG  = MPTLC.VPOCHA(NLCEG, 1)
            RVG  = MPRVC.VPOCHA(NLCEG, 1)
            RLG  = MPRLC.VPOCHA(NLCEG, 1)
            UVXG = MPUVC.VPOCHA(NLCEG, 1)
            UVYG = MPUVC.VPOCHA(NLCEG, 2)
            ULXG = MPULC.VPOCHA(NLCEG, 1)
            ULYG = MPULC.VPOCHA(NLCEG, 2)
            UVNG = UVXG * CNX + UVYG * CNY
            UVTG = UVXG * CTX + UVYG * CTY
            ULNG = ULXG * CNX + ULYG * CNY
            ULTG = ULXG * CTX + ULYG * CTY
C
C********** Son etat droite
C
            AD  = AG
            PD  = PG
            TVD = TVG
            TLD = TLG
            RVD = RVG
            RLD = RLG
            UVND = -1.0D0 * UVNG
            UVTD = UVTG
            ULND = -1.0D0 * ULNG
            ULTD = ULTG
C
C************* Fin cas mur
C
         ELSE
C
C************* Etat gauche
C
            AG   = MPALP.VPOCHA(NLCEG, 1)
            PG   = MPPC.VPOCHA(NLCEG, 1)
            TVG  = MPTVC.VPOCHA(NLCEG, 1)
            TLG  = MPTLC.VPOCHA(NLCEG, 1)
            RVG  = MPRVC.VPOCHA(NLCEG, 1)
            RLG  = MPRLC.VPOCHA(NLCEG, 1)
            UVXG = MPUVC.VPOCHA(NLCEG, 1)
            UVYG = MPUVC.VPOCHA(NLCEG, 2)
            ULXG = MPULC.VPOCHA(NLCEG, 1)
            ULYG = MPULC.VPOCHA(NLCEG, 2)
            UVNG = UVXG * CNX + UVYG * CNY
            UVTG = UVXG * CTX + UVYG * CTY
            ULNG = ULXG * CNX + ULYG * CNY
            ULTG = ULXG * CTX + ULYG * CTY
C
C********** Etat gauche
C
            AD   = MPALP.VPOCHA(NLCED, 1)
            PD   = MPPC.VPOCHA(NLCED, 1)
            TVD  = MPTVC.VPOCHA(NLCED, 1)
            TLD  = MPTLC.VPOCHA(NLCED, 1)
            RVD  = MPRVC.VPOCHA(NLCED, 1)
            RLD  = MPRLC.VPOCHA(NLCED, 1)
            UVXD = MPUVC.VPOCHA(NLCED, 1)
            UVYD = MPUVC.VPOCHA(NLCED, 2)
            ULXD = MPULC.VPOCHA(NLCED, 1)
            ULYD = MPULC.VPOCHA(NLCED, 2)
            UVND = UVXD * CNX + UVYD * CNY
            UVTD = UVXD * CTX + UVYD * CTY
            ULND = ULXD * CNX + ULYD * CNY
            ULTD = ULXD * CTX + ULYD * CTY
         ENDIF
C
C************* Les MELVALs
C
         MLALP.VELCHE(1,NLCF) = AG
         MLALP.VELCHE(3,NLCF) = AD
         MLP.VELCHE(1,NLCF)  = PG
         MLP.VELCHE(3,NLCF)  = PD
         MLTV.VELCHE(1,NLCF) = TVG
         MLTV.VELCHE(3,NLCF) = TVD
         MLTL.VELCHE(1,NLCF) = TLG
         MLTL.VELCHE(3,NLCF) = TLD
         MLRV.VELCHE(1,NLCF) = RVG
         MLRV.VELCHE(3,NLCF) = RVD
         MLRL.VELCHE(1,NLCF) = RLG
         MLRL.VELCHE(3,NLCF) = RLD

         MLUVN.VELCHE(1,NLCF) = UVNG
         MLUVN.VELCHE(3,NLCF) = UVND
         MLUVT.VELCHE(1,NLCF) = UVTG
         MLUVT.VELCHE(3,NLCF) = UVTD
         MLULN.VELCHE(1,NLCF) = ULNG
         MLULN.VELCHE(3,NLCF) = ULND
         MLULT.VELCHE(1,NLCF) = ULTG
         MLULT.VELCHE(3,NLCF) = ULTD

C LAS QUE VIENEN A CONTINUACION NO SIRVEN, TENEMOS LAS
C MISMAS DIRECCIONES TANTO PARA LA FASE LIQUIDA COMO PARA
C LA GASEOSA

         MLVNX.VELCHE(1,NLCF) = CNX
         MLVNY.VELCHE(1,NLCF) = CNY
         MLVTX.VELCHE(1,NLCF) = CTX
         MLVTY.VELCHE(1,NLCF) = CTY

         MLLNX.VELCHE(1,NLCF) = CNX
         MLLNY.VELCHE(1,NLCF) = CNY
         MLLTX.VELCHE(1,NLCF) = CTX
         MLLTY.VELCHE(1,NLCF) = CTY

      ENDDO
C
C**** Desactivation des SEGMENTs
C
      SEGDES IPT1
      SEGDES IPT2
C
      SEGDES MPALP
      SEGDES MPUVC
      SEGDES MPULC
      SEGDES MPPC
      SEGDES MPTVC
      SEGDES MPTLC
      SEGDES MPRVC
      SEGDES MPRLC
      SEGDES MPNORM
C
      SEGDES MLALP
      SEGDES MLP
      SEGDES MLTV
      SEGDES MLTL
      SEGDES MLRV
      SEGDES MLRL

C liquid vectors same as vapour ones,
C there should have been only one set

      SEGDES MLUVN
      SEGDES MLUVT
      SEGDES MLULN
      SEGDES MLULT

      SEGDES MLVNX
      SEGDES MLVNY
      SEGDES MLVTX
      SEGDES MLVTY
      SEGDES MLLNX
      SEGDES MLLNY
      SEGDES MLLTX
      SEGDES MLLTY
C
C**** Destruction du MELNTI correspondance local/global
C
      SEGSUP MLENT1
C
 9999 CONTINUE
C
      RETURN
      END