Télécharger pre611.eso

Retour à la liste

pre611
C PRE611    SOURCE    CB215821  20/11/25    13:36:34     10792          
      SUBROUTINE PRE611(ICEN,IFACE,IFACEL,INORM,
     &        IAL1, IGRAL1, ILIAL1,
     &        IAL2, IGRAL2, ILIAL2,
     &        IRN1, IGRRN1, ILIRN1,
     &        IRN2, IGRRN2, ILIRN2,
     &        IVN1, IGRVN1, ILIVN1,
     &        IVN2, IGRVN2, ILIVN2,
     &        IPN1, IGRPN1, ILIPN1,
     &        IPN2, IGRPN2, ILIPN2,
     &        IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE611
C
C DESCRIPTION       :  Voir PRE61
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
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     IAL1, IGRAL1, ILIAL1,
C     IAL2, IGRAL2, ILIAL2.
C     CHPOINT "CENTRE" de fractions volumiques, gradients et limiteurs
C
C     IRN1, IGRRN1, ILIRN1,
C     IRN2, IGRRN2, ILIRN2.
C     CHPOINT "CENTRE" de densités, gradients et limiteurs
C
C     IVN1, IGRVN1, ILIVN1,
C     IVN2, IGRVN2, ILIVN2.
C     CHPOINT "CENTRE" de vitesses, gradients et limiteurs
C
C     IPN1, IGRPN1, ILIPN1,
C     IPN2, IGRPN2, ILIPN2.
C     CHPOINT "CENTRE" de pression, gradients et limiteurs
C
C
C SORTIES
C
C     IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F.
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.09.
C               Estension au 3D le 21.12.2010
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 IAL1, IGRAL1, ILIAL1
     &     , IAL2, IGRAL2, ILIAL2
     &     , IRN1, IGRRN1, ILIRN1
     &     , IRN2, IGRRN2, ILIRN2
     &     , IVN1, IGRVN1, ILIVN1
     &     , IVN2, IGRVN2, ILIVN2
     &     , IPN1, IGRPN1, ILIPN1
     &     , IPN2, IGRPN2, ILIPN2
     &     , IAL1F, IAL2F, IRN1F, IRN2F
     &     , IVN1F, IVN2F, IPN1F, IPN2F
     &     , IGEOM, NFAC, NCEN
     &     , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
     &     , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
     &     , IDIMP1, INDCEL
      REAL*8 XG, YG, ZG, XC, YC, ZC, XD, YD, ZD
     &     ,DXG, DYG, DZG, DXD, DYD, DZD
     &     , CNX, CNY, CNZ, CTX, CTY, CTZ, ORIENT
     &     , CVX, CVY, CVZ
     &     , AL1G, AL2G, RN1G, RN2G, PN1G, PN2G
     &     , UX1G, UX2G, UY1G, UY2G, UZ1G, UZ2G
     &     , UN1G, UN2G, UT1G, UT2G, UV1G, UV2G
     &     , AL1D, AL2D, RN1D, RN2D, PN1D, PN2D
     &     , UX1D, UX2D, UY1D, UY2D, UZ1D, UZ2D
     &     , UN1D, UN2D, UT1D, UT2D, UV1D, UV2D
     &     , VALCEL, DCEL, LIMCEL
      CHARACTER*(40) MESERR
      CHARACTER*(8) TYPE
      LOGICAL LOGI1
C
C**** Les Includes
C
-INC SMCOORD
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPAL1.MPOVAL,  MPGAL1.MPOVAL, MPLAL1.MPOVAL
      POINTEUR MPAL2.MPOVAL,  MPGAL2.MPOVAL, MPLAL2.MPOVAL
      POINTEUR MPRN1.MPOVAL,  MPGRN1.MPOVAL, MPLRN1.MPOVAL
      POINTEUR MPRN2.MPOVAL,  MPGRN2.MPOVAL, MPLRN2.MPOVAL
      POINTEUR MPVN1.MPOVAL,  MPGVN1.MPOVAL, MPLVN1.MPOVAL
      POINTEUR MPVN2.MPOVAL,  MPGVN2.MPOVAL, MPLVN2.MPOVAL
      POINTEUR MPPN1.MPOVAL,  MPGPN1.MPOVAL, MPLPN1.MPOVAL
      POINTEUR MPPN2.MPOVAL,  MPGPN2.MPOVAL, MPLPN2.MPOVAL
      POINTEUR MPNORM.MPOVAL
-INC SMCHAML
C     Melval des cosinus directeurs
      POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL,
     &     MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL,
     &     MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL
C     Melval des vitesses
      POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL, MEVUV1.MELVAL,
     &     MEVUN2.MELVAL, MEVUT2.MELVAL, MEVUV2.MELVAL
C     Melval des densités, pressions, alphas
      POINTEUR MELRN1.MELVAL, MELRN2.MELVAL
      POINTEUR MELPN1.MELVAL, MELPN2.MELVAL
      POINTEUR MELAL1.MELVAL, MELAL2.MELVAL
-INC SMLENTI
-INC SMELEME
C
      mcham1 = 0
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     alpha    + grad + limiteur
C     densité  + grad + limiteur
C     vitesse  + grad + limiteur
C     pression + grad + limiteur
C     cosinus directeurs des normales aux surface
C
      CALL LICHT(IAL1    , MPAL1   , TYPE, IGEOM)
C     SEGACT MPAL1
      CALL LICHT(IGRAL1  , MPGAL1  , TYPE, IGEOM)
C     SEGACT MPGAL1
      CALL LICHT(ILIAL1  , MPLAL1  , TYPE, IGEOM)
C     SEGACT MPLAL1
      CALL LICHT(IAL2    , MPAL2   , TYPE, IGEOM)
C     SEGACT MPAL2
      CALL LICHT(IGRAL2  , MPGAL2  , TYPE, IGEOM)
C     SEGACT MPGAL2
      CALL LICHT(ILIAL2  , MPLAL2  , TYPE, IGEOM)
C     SEGACT MPLAL2
      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(IRN2    , MPRN2   , TYPE, IGEOM)
C     SEGACT MPRN2
      CALL LICHT(IGRRN2  , MPGRN2  , TYPE, IGEOM)
C     SEGACT MPGRN2
      CALL LICHT(ILIRN2  , MPLRN2  , TYPE, IGEOM)
C     SEGACT MPLRN2
      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(IVN2    , MPVN2   , TYPE, IGEOM)
C     SEGACT MPVN2
      CALL LICHT(IGRVN2  , MPGVN2  , TYPE, IGEOM)
C     SEGACT MPGVN2
      CALL LICHT(ILIVN2  , MPLVN2  , TYPE, IGEOM)
C     SEGACT MPLVN2
      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
      CALL LICHT(IPN2    , MPPN2   , TYPE, IGEOM)
C     SEGACT MPPN2
      CALL LICHT(IGRPN2  , MPGPN2  , TYPE, IGEOM)
C     SEGACT MPGPN2
      CALL LICHT(ILIPN2  , MPLPN2  , TYPE, IGEOM)
C     SEGACT MPLPN2
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
      IF (IDIM .EQ. 2) THEN
         MCHEL1.CONCHE(1) = '(n,t) in (x,y)  '
         MCHEL1.CONCHE(2) = ' U in (n,t)     '
      ELSE
         MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)'
         MCHEL1.CONCHE(2) = ' U in (n,t,v)   '
      ENDIF
*      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 = 3 -> 9 composantes
C     IDIM = 2 -> 4 composantes
C
      IF (IDIM .EQ. 2)THEN
         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
      ELSEIF (IDIM .EQ. 3) THEN
         N2 = 9
         SEGINI MCHAM1
         MCHEL1.ICHAML(1) = MCHAM1
         MCHAM1.NOMCHE(1) = 'NX      '
         MCHAM1.NOMCHE(2) = 'NY      '
         MCHAM1.NOMCHE(3) = 'NZ      '
         MCHAM1.NOMCHE(4) = 'TX      '
         MCHAM1.NOMCHE(5) = 'TY      '
         MCHAM1.NOMCHE(6) = 'TZ      '
         MCHAM1.NOMCHE(7) = 'VX      '
         MCHAM1.NOMCHE(8) = 'VY      '
         MCHAM1.NOMCHE(9) = 'VZ      '
         MCHAM1.TYPCHE(1) = 'REAL*8          '
         MCHAM1.TYPCHE(2) = 'REAL*8          '
         MCHAM1.TYPCHE(3) = 'REAL*8          '
         MCHAM1.TYPCHE(4) = 'REAL*8          '
         MCHAM1.TYPCHE(5) = 'REAL*8          '
         MCHAM1.TYPCHE(6) = 'REAL*8          '
         MCHAM1.TYPCHE(7) = 'REAL*8          '
         MCHAM1.TYPCHE(8) = 'REAL*8          '
         MCHAM1.TYPCHE(9) = 'REAL*8          '
         SEGINI MELVNX
         SEGINI MELVNY
         SEGINI MELVNZ
         SEGINI MELT1X
         SEGINI MELT1Y
         SEGINI MELT1Z
         SEGINI MELT2X
         SEGINI MELT2Y
         SEGINI MELT2Z
         MCHAM1.IELVAL(1) = MELVNX
         MCHAM1.IELVAL(2) = MELVNY
         MCHAM1.IELVAL(3) = MELVNZ
         MCHAM1.IELVAL(4) = MELT1X
         MCHAM1.IELVAL(5) = MELT1Y
         MCHAM1.IELVAL(6) = MELT1Z
         MCHAM1.IELVAL(7) = MELT2X
         MCHAM1.IELVAL(8) = MELT2Y
         MCHAM1.IELVAL(9) = MELT2Z
      ENDIF
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     IDIM = 3 -> 3 composantes
C
      N2 = IDIM
      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
      IF (IDIM .EQ. 3) THEN
         MCHAM1.NOMCHE(3) = 'UV      '
         MCHAM1.TYPCHE(3) = 'REAL*8          '
         SEGINI MEVUV1
         MCHAM1.IELVAL(3) = MEVUV1
      ENDIF
C
C**** Vitesse 2
C
      MCHEL1 = IVN1F
      SEGINI, MCHEL2 = MCHEL1
      IVN2F = MCHEL2
C     The MCHEL2.ICHAML(1) contiens le cosinus directeurs
C     => MCHEL2.ICHAML(1) = MCHEL1.ICHAML(1)
      MCHAM1 = MCHEL1.ICHAML(2)
      SEGDES MCHEL1
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(2) = MCHAM2
      SEGDES MCHEL2
      SEGINI, MEVUN2 = MEVUN1
      SEGINI, MEVUT2 = MEVUT1
      MCHAM2.IELVAL(1) = MEVUN2
      MCHAM2.IELVAL(2) = MEVUT2
      IF (IDIM .EQ. 3)THEN
         SEGINI, MEVUV2 = MEVUV1
         MCHAM2.IELVAL(3) = MEVUV2
      ENDIF
      SEGDES MCHAM2
C
C**********************************************************
C**** Alpha1 and alpha2                            ********
C**********************************************************
C
C**** Alpha1
C
      N1 = 1
      N3 = 6
      L1 = 15
      SEGINI MCHEL2
      IAL1F = MCHEL2
      MCHEL2.IMACHE(1) = IFACEL
      MCHEL2.TITCHE = 'ALPHA1         '
      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      SEGDES MCHEL2
      MCHAM1.NOMCHE(1) = 'SCAL    '
      MCHAM1.TYPCHE(1) = 'REAL*8          '
      SEGINI MELAL1
      MCHAM1.IELVAL(1) = MELAL1
      SEGDES MCHAM1
C
C**** Alpha2
C
      MCHEL1 = IAL1F
      SEGINI, MCHEL2 = MCHEL1
      IAL2F = MCHEL2
      MCHEL2.TITCHE = 'ALPHA2       '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MELAL2
      MCHAM2.IELVAL(1) = MELAL2
      SEGDES MCHAM2
C
C**********************************************************
C**** IRN1F and IRN2F                              ********
C**********************************************************
C
      MCHEL1 = IAL1F
      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
      MCHEL1 = IAL1F
      SEGINI, MCHEL2 = MCHEL1
      IRN2F = MCHEL2
      MCHEL2.TITCHE = 'RHO2         '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MELRN2
      MCHAM2.IELVAL(1) = MELRN2
      SEGDES MCHAM2
C
C
C**********************************************************
C**** IRN1F and IRN2F                              ********
C**********************************************************
C
      MCHEL1 = IAL1F
      SEGINI, MCHEL2 = MCHEL1
      IPN1F = MCHEL2
      MCHEL2.TITCHE = 'P1           '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MELPN1
      MCHAM2.IELVAL(1) = MELPN1
      SEGDES MCHAM2
C
C
      MCHEL1 = IAL1F
      SEGINI, MCHEL2 = MCHEL1
      IPN2F = MCHEL2
      MCHEL2.TITCHE = 'P2           '
      MCHAM1 = MCHEL1.ICHAML(1)
      SEGINI, MCHAM2 = MCHAM1
      MCHEL2.ICHAML(1) = MCHAM2
      SEGDES MCHEL2
      SEGINI MELPN2
      MCHAM2.IELVAL(1) = MELPN2
      SEGDES MCHAM2
      SEGDES MCHEL1
C
C**********************************************************
C**** Boucle sur le faces                         *********
C**********************************************************
C
      CNZ = 0.0D0
      CTZ = 0.0D0
      DZG = 0.0D0
      DZD = 0.0D0
      CVX = 0.0D0
      CVY = 0.0D0
      CVZ = 0.0D0
      UZ1G = 0.0D0
      UZ1D = 0.0D0
      UZ2G = 0.0D0
      UZ2D = 0.0D0
C
      IDIMP1 = IDIM + 1
      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
         IF (IDIM .EQ. 3) THEN
            INDCEL = (NGCEG-1)*IDIMP1
            ZG = XCOOR(INDCEL+3)
            INDCEL = (NGCF-1)*IDIMP1
            ZC = XCOOR(INDCEL + 3)
            INDCEL = (NGCED-1)*IDIMP1
            ZD = XCOOR(INDCEL+3)
            DZG = ZC - ZG
            DZD = ZC - ZD
C
            CNX = MPNORM.VPOCHA(NLCF,7)
            CNY = MPNORM.VPOCHA(NLCF,8)
            CNZ = MPNORM.VPOCHA(NLCF,9)
            ORIENT = (CNX * DXG) + (CNY * DYG) + (CNZ * DZG)
         ENDIF
         ORIENT = SIGN(1.0D0,ORIENT)
         IF(ORIENT .NE. 1.0D0)THEN
            MESERR(1:30)=
     &           'PRET , subroutine pre612.eso. '
            GOTO 9999
         ENDIF
         CNX = CNX * ORIENT
         CNY = CNY * ORIENT
         CNZ = CNZ * ORIENT
C
C******* Cosinus directeurs de tangent 2D
C
         CTX = -1.0D0 * CNY
         CTY = CNX
         IF (IDIM .EQ. 3) THEN
C
C********** Cosinus directeurs de tangente 1
C
            CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT
            CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT
            CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT
C
C********** Cosinus directeurs de tangente 2
C
            CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT
            CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT
            CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT
C
         ENDIF
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        ALPHA
C
         VALCEL = MPAL1.VPOCHA(NLCEG, 1)
         LIMCEL = MPLAL1.VPOCHA(NLCEG, 1)
         DCEL = (MPGAL1.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGAL1.VPOCHA(NLCEG, 2) * DYG)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGAL1.VPOCHA(NLCEG, 3) * DZG)
         AL1G = VALCEL + (LIMCEL * DCEL)
C         write(*,*) valcel, limcel, dcel
C
         VALCEL = MPAL2.VPOCHA(NLCEG, 1)
         LIMCEL = MPLAL2.VPOCHA(NLCEG, 1)
         DCEL = (MPGAL2.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGAL2.VPOCHA(NLCEG, 2) * DYG)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGAL2.VPOCHA(NLCEG, 3) * DZG)
         AL2G = VALCEL + (LIMCEL * DCEL)
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)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGRN1.VPOCHA(NLCEG, 3) * DZG)
         RN1G = VALCEL + (LIMCEL * DCEL)
C
         VALCEL = MPRN2.VPOCHA(NLCEG, 1)
         LIMCEL = MPLRN2.VPOCHA(NLCEG, 1)
         DCEL = (MPGRN2.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGRN2.VPOCHA(NLCEG, 2) * DYG)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGRN2.VPOCHA(NLCEG, 3) * DZG)
         RN2G = VALCEL + (LIMCEL * DCEL)
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)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGPN1.VPOCHA(NLCEG, 3) * DZG)
         PN1G = VALCEL + (LIMCEL * DCEL)
C
         VALCEL = MPPN2.VPOCHA(NLCEG, 1)
         LIMCEL = MPLPN2.VPOCHA(NLCEG, 1)
         DCEL = (MPGPN2.VPOCHA(NLCEG, 1) * DXG) +
     &        (MPGPN2.VPOCHA(NLCEG, 2) * DYG)
         IF (IDIM .EQ. 3) DCEL = DCEL +
     &        (MPGPN2.VPOCHA(NLCEG, 3) * DZG)
         PN2G = VALCEL + (LIMCEL * DCEL)
C
C        VN
C
         IF (IDIM .EQ. 2) THEN
            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
            VALCEL = MPVN2.VPOCHA(NLCEG, 1)
            LIMCEL = MPLVN2.VPOCHA(NLCEG, 1)
            DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG +
     &           MPGVN2.VPOCHA(NLCEG, 2)*DYG
            UX2G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN2.VPOCHA(NLCEG, 2)
            LIMCEL = MPLVN2.VPOCHA(NLCEG, 2)
            DCEL = MPGVN2.VPOCHA(NLCEG, 3)*DXG +
     &           MPGVN2.VPOCHA(NLCEG, 4)*DYG
            UY2G = VALCEL + LIMCEL * DCEL
         ELSE
            VALCEL = MPVN1.VPOCHA(NLCEG, 1)
            LIMCEL = MPLVN1.VPOCHA(NLCEG, 1)
            DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG +
     &           MPGVN1.VPOCHA(NLCEG, 2)*DYG +
     &           MPGVN1.VPOCHA(NLCEG, 3)*DZG
            UX1G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN1.VPOCHA(NLCEG, 2)
            LIMCEL = MPLVN1.VPOCHA(NLCEG, 2)
            DCEL = MPGVN1.VPOCHA(NLCEG, 4)*DXG +
     &           MPGVN1.VPOCHA(NLCEG, 5)*DYG +
     &           MPGVN1.VPOCHA(NLCEG, 6)*DZG
            UY1G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN1.VPOCHA(NLCEG, 3)
            LIMCEL = MPLVN1.VPOCHA(NLCEG, 3)
            DCEL = MPGVN1.VPOCHA(NLCEG, 7)*DXG +
     &           MPGVN1.VPOCHA(NLCEG, 8)*DYG +
     &           MPGVN1.VPOCHA(NLCEG, 9)*DZG
            UZ1G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN2.VPOCHA(NLCEG, 1)
            LIMCEL = MPLVN2.VPOCHA(NLCEG, 1)
            DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG +
     &           MPGVN2.VPOCHA(NLCEG, 2)*DYG +
     &           MPGVN2.VPOCHA(NLCEG, 3)*DZG
            UX2G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN2.VPOCHA(NLCEG, 2)
            LIMCEL = MPLVN2.VPOCHA(NLCEG, 2)
            DCEL = MPGVN2.VPOCHA(NLCEG, 4)*DXG +
     &           MPGVN2.VPOCHA(NLCEG, 5)*DYG +
     &           MPGVN2.VPOCHA(NLCEG, 6)*DZG
            UY2G = VALCEL + LIMCEL * DCEL
C
            VALCEL = MPVN2.VPOCHA(NLCEG, 3)
            LIMCEL = MPLVN2.VPOCHA(NLCEG, 3)
            DCEL = MPGVN2.VPOCHA(NLCEG, 7)*DXG +
     &           MPGVN2.VPOCHA(NLCEG, 8)*DYG +
     &           MPGVN2.VPOCHA(NLCEG, 9)*DZG
            UZ2G = VALCEL + LIMCEL * DCEL
         ENDIF
 
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; mais, vu
C        que le limiteur n'est pas calculé ici, mais dans un autre
C        operateur, on le fait
C
         LOGI1 = (RN1G .LT. 0.0D0) .OR. (RN2G .LT. 0.0D0) .OR.
     &        (PN1G .LT. 0.0D0) .OR. (PN2G .LT. 0.0D0) .OR.
     &        (AL1G .LT. 0.0D0) .OR. (AL2G .LT. 0.0D0) .OR.
     &        (AL1G .GT. 1.0D0) .OR. (AL2G .GT. 1.0D0)
C
         IF ( NGCEG .EQ. NGCED) THEN
C
C********** Cas mur
C
            IF(LOGI1)THEN
C
C********** Premier ordre en espace local
C
               AL1G = MPAL1.VPOCHA(NLCEG,1)
               AL2G = MPAL2.VPOCHA(NLCEG,1)
               RN1G = MPRN1.VPOCHA(NLCEG,1)
               RN2G = MPRN2.VPOCHA(NLCEG,1)
               PN1G = MPPN1.VPOCHA(NLCEG,1)
               PN2G = MPPN2.VPOCHA(NLCEG,1)
               UX1G = MPVN1.VPOCHA(NLCEG,1)
               UY1G = MPVN1.VPOCHA(NLCEG,2)
               UX2G = MPVN2.VPOCHA(NLCEG,1)
               UY2G = MPVN2.VPOCHA(NLCEG,2)
               IF (IDIM .EQ. 3) THEN
                  UZ1G = MPVN1.VPOCHA(NLCEG,3)
                  UZ2G = MPVN2.VPOCHA(NLCEG,3)
               ENDIF
            ENDIF
C
            UN1G = UX1G * CNX + UY1G * CNY +  UZ1G * CNZ
            UT1G = UX1G * CTX + UY1G * CTY +  UZ1G * CTZ
            UN2G = UX2G * CNX + UY2G * CNY +  UZ2G * CNZ
            UT2G = UX2G * CTX + UY2G * CTY +  UZ2G * CTZ
            UV1G = UX1G * CVX + UY1G * CVY +  UZ1G * CVZ
            UV2G = UX2G * CVX + UY2G * CVY +  UZ2G * CVZ
C
C********** Son etat droite
C
            AL1D = AL1G
            AL2D = AL2G
            RN1D = RN1G
            RN2D = RN2G
            PN1D = PN1G
            PN2D = PN2G
            UN1D = -1.0D0 * UN1G
            UN2D = -1.0D0 * UN2G
            UT1D = UT1G
            UT2D = UT2G
            UV1D = UV1G
            UV2D = UV2G
C
C********** Fin cas mur
C
         ELSE
            VALCEL = MPAL1.VPOCHA(NLCED, 1)
            LIMCEL = MPLAL1.VPOCHA(NLCED, 1)
            DCEL = (MPGAL1.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGAL1.VPOCHA(NLCED, 2) * DYD)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGAL1.VPOCHA(NLCED, 3) * DZD)
            AL1D = VALCEL + (LIMCEL * DCEL)
C
            VALCEL = MPAL2.VPOCHA(NLCED, 1)
            LIMCEL = MPLAL2.VPOCHA(NLCED, 1)
            DCEL = (MPGAL2.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGAL2.VPOCHA(NLCED, 2) * DYD)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGAL2.VPOCHA(NLCED, 3) * DZD)
            AL2D = 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)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGRN1.VPOCHA(NLCED, 3) * DZD)
            RN1D = VALCEL + (LIMCEL * DCEL)
C
            VALCEL = MPRN2.VPOCHA(NLCED, 1)
            LIMCEL = MPLRN2.VPOCHA(NLCED, 1)
            DCEL = (MPGRN2.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGRN2.VPOCHA(NLCED, 2) * DYD)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGRN2.VPOCHA(NLCED, 3) * DZD)
            RN2D = 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)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGPN1.VPOCHA(NLCED, 3) * DZD)
            PN1D = VALCEL + (LIMCEL * DCEL)
C
            VALCEL = MPPN2.VPOCHA(NLCED, 1)
            LIMCEL = MPLPN2.VPOCHA(NLCED, 1)
            DCEL = (MPGPN2.VPOCHA(NLCED, 1) * DXD) +
     &             (MPGPN2.VPOCHA(NLCED, 2) * DYD)
            IF (IDIM .EQ. 3) DCEL = DCEL +
     &           (MPGPN2.VPOCHA(NLCED, 3) * DZD)
            PN2D = VALCEL + (LIMCEL * DCEL)
C
C           VN
C
            IF (IDIM .EQ. 2) THEN
               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
               VALCEL = MPVN2.VPOCHA(NLCED, 1)
               LIMCEL = MPLVN2.VPOCHA(NLCED, 1)
               DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD +
     &              MPGVN2.VPOCHA(NLCED, 2)*DYD
               UX2D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN2.VPOCHA(NLCED, 2)
               LIMCEL = MPLVN2.VPOCHA(NLCED, 2)
               DCEL = MPGVN2.VPOCHA(NLCED, 3)*DXD +
     &              MPGVN2.VPOCHA(NLCED, 4)*DYD
               UY2D = VALCEL + LIMCEL * DCEL
            ELSE
               VALCEL = MPVN1.VPOCHA(NLCED, 1)
               LIMCEL = MPLVN1.VPOCHA(NLCED, 1)
               DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD +
     &              MPGVN1.VPOCHA(NLCED, 2)*DYD +
     &              MPGVN1.VPOCHA(NLCED, 3)*DZD
               UX1D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN1.VPOCHA(NLCED, 2)
               LIMCEL = MPLVN1.VPOCHA(NLCED, 2)
               DCEL = MPGVN1.VPOCHA(NLCED, 4)*DXD +
     &              MPGVN1.VPOCHA(NLCED, 5)*DYD +
     &              MPGVN1.VPOCHA(NLCED, 6)*DZD
               UY1D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN1.VPOCHA(NLCED, 3)
               LIMCEL = MPLVN1.VPOCHA(NLCED, 3)
               DCEL = MPGVN1.VPOCHA(NLCED, 7)*DXD +
     &              MPGVN1.VPOCHA(NLCED, 8)*DYD +
     &              MPGVN1.VPOCHA(NLCED, 9)*DZD
               UZ1D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN2.VPOCHA(NLCED, 1)
               LIMCEL = MPLVN2.VPOCHA(NLCED, 1)
               DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD +
     &              MPGVN2.VPOCHA(NLCED, 2)*DYD +
     &              MPGVN2.VPOCHA(NLCED, 3)*DZD
               UX2D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN2.VPOCHA(NLCED, 2)
               LIMCEL = MPLVN2.VPOCHA(NLCED, 2)
               DCEL = MPGVN2.VPOCHA(NLCED, 4)*DXD +
     &              MPGVN2.VPOCHA(NLCED, 5)*DYD +
     &              MPGVN2.VPOCHA(NLCED, 6)*DZD
               UY2D = VALCEL + LIMCEL * DCEL
C
               VALCEL = MPVN2.VPOCHA(NLCED, 3)
               LIMCEL = MPLVN2.VPOCHA(NLCED, 3)
               DCEL = MPGVN2.VPOCHA(NLCED, 7)*DXD +
     &              MPGVN2.VPOCHA(NLCED, 8)*DYD +
     &              MPGVN2.VPOCHA(NLCED, 9)*DZD
               UZ2D = VALCEL + LIMCEL * DCEL
C
            ENDIF
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; mais, vu
C           que le limiteur n'est pas calculé ici, mais dans un autre
C           operateur, on le fait
C
            LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0) .OR. (RN2D .LT. 0.0D0)
     $           .OR.(PN1D .LT. 0.0D0) .OR. (PN2D .LT. 0.0D0) .OR.
     $           (AL1D .LT. 0.0D0) .OR. (AL2D .LT. 0.0D0) .OR.
     $           (AL1D .GT. 1.0D0) .OR. (AL2D .GT. 1.0D0)
C
            IF(LOGI1)THEN
C
C************* Premier ordre en espace local
C
               AL1G = MPAL1.VPOCHA(NLCEG,1)
               AL2G = MPAL2.VPOCHA(NLCEG,1)
               RN1G = MPRN1.VPOCHA(NLCEG,1)
               RN2G = MPRN2.VPOCHA(NLCEG,1)
               PN1G = MPPN1.VPOCHA(NLCEG,1)
               PN2G = MPPN2.VPOCHA(NLCEG,1)
               UX1G = MPVN1.VPOCHA(NLCEG,1)
               UY1G = MPVN1.VPOCHA(NLCEG,2)
               UX2G = MPVN2.VPOCHA(NLCEG,1)
               UY2G = MPVN2.VPOCHA(NLCEG,2)
C
               AL1D = MPAL1.VPOCHA(NLCED,1)
               AL2D = MPAL2.VPOCHA(NLCED,1)
               RN1D = MPRN1.VPOCHA(NLCED,1)
               RN2D = MPRN2.VPOCHA(NLCED,1)
               PN1D = MPPN1.VPOCHA(NLCED,1)
               PN2D = MPPN2.VPOCHA(NLCED,1)
               UX1D = MPVN1.VPOCHA(NLCED,1)
               UY1D = MPVN1.VPOCHA(NLCED,2)
               UX2D = MPVN2.VPOCHA(NLCED,1)
               UY2D = MPVN2.VPOCHA(NLCED,2)
C
               IF (IDIM .EQ. 3) THEN
                  UZ1G = MPVN1.VPOCHA(NLCEG,3)
                  UZ2G = MPVN2.VPOCHA(NLCEG,3)
                  UZ1D = MPVN1.VPOCHA(NLCED,3)
                  UZ2D = MPVN2.VPOCHA(NLCED,3)
               ENDIF
 
            ENDIF
C
            UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ
            UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ
            UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ
            UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ
            UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ
            UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ
C
            UN1D = UX1D * CNX + UY1D * CNY + UZ1D * CNZ
            UT1D = UX1D * CTX + UY1D * CTY + UZ1D * CTZ
            UV1D = UX1D * CVX + UY1D * CVY + UZ1D * CVZ
            UN2D = UX2D * CNX + UY2D * CNY + UZ2D * CNZ
            UT2D = UX2D * CTX + UY2D * CTY + UZ2D * CTZ
            UV2D = UX2D * CVX + UY2D * CVY + UZ2D * CVZ
C
         ENDIF
C
C
C******** Les MELVALs
C
         MELAL1.VELCHE(1,NLCF) = AL1G
         MELAL1.VELCHE(3,NLCF) = AL1D
         MELAL2.VELCHE(1,NLCF) = AL2G
         MELAL2.VELCHE(3,NLCF) = AL2D
C
         MELRN1.VELCHE(1,NLCF) = RN1G
         MELRN1.VELCHE(3,NLCF) = RN1D
         MELRN2.VELCHE(1,NLCF) = RN2G
         MELRN2.VELCHE(3,NLCF) = RN2D
C
         MELPN1.VELCHE(1,NLCF) = PN1G
         MELPN1.VELCHE(3,NLCF) = PN1D
         MELPN2.VELCHE(1,NLCF) = PN2G
         MELPN2.VELCHE(3,NLCF) = PN2D
C
         MEVUN1.VELCHE(1,NLCF) = UN1G
         MEVUN1.VELCHE(3,NLCF) = UN1D
         MEVUT1.VELCHE(1,NLCF) = UT1G
         MEVUT1.VELCHE(3,NLCF) = UT1D
         MEVUN2.VELCHE(1,NLCF) = UN2G
         MEVUN2.VELCHE(3,NLCF) = UN2D
         MEVUT2.VELCHE(1,NLCF) = UT2G
         MEVUT2.VELCHE(3,NLCF) = UT2D
         MELVNX.VELCHE(1,NLCF) = CNX
         MELVNY.VELCHE(1,NLCF) = CNY
         MELT1X.VELCHE(1,NLCF) = CTX
         MELT1Y.VELCHE(1,NLCF) = CTY
         IF (IDIM .EQ. 3) THEN
            MELVNZ.VELCHE(1,NLCF) = CNZ
            MELT1Z.VELCHE(1,NLCF) = CTZ
            MELT2X.VELCHE(1,NLCF) = CVX
            MELT2Y.VELCHE(1,NLCF) = CVY
            MELT2Z.VELCHE(1,NLCF) = CVZ
C
            MEVUV1.VELCHE(1,NLCF) = UV1G
            MEVUV1.VELCHE(3,NLCF) = UV1D
            MEVUV2.VELCHE(1,NLCF) = UV2G
            MEVUV2.VELCHE(3,NLCF) = UV2D
         ENDIF
      ENDDO
C
C**** Desactivation des SEGMENTs
C
      SEGDES IPT1
      SEGDES IPT2
C
C     MPOVALs
C
      SEGDES MPNORM
C
      SEGDES MPAL1
      SEGDES MPGAL1
      SEGDES MPLAL1
      SEGDES MPAL2
      SEGDES MPGAL2
      SEGDES MPLAL2
C
      SEGDES MPRN1
      SEGDES MPGRN1
      SEGDES MPLRN1
      SEGDES MPRN2
      SEGDES MPGRN2
      SEGDES MPLRN2
C
      SEGDES MPPN1
      SEGDES MPGPN1
      SEGDES MPLPN1
      SEGDES MPPN2
      SEGDES MPGPN2
      SEGDES MPLPN2
C
      SEGDES MPVN1
      SEGDES MPGVN1
      SEGDES MPLVN1
      SEGDES MPVN2
      SEGDES MPGVN2
      SEGDES MPLVN2
C
C     MELVALs
C
      SEGDES MELVNX
      SEGDES MELVNY
      SEGDES MELT1X
      SEGDES MELT1Y
      SEGDES MEVUN1
      SEGDES MEVUT1
      SEGDES MEVUN2
      SEGDES MEVUT2
      IF (IDIM .EQ. 3) THEN
         SEGDES MELVNZ
         SEGDES MELT1Z
         SEGDES MELT2X
         SEGDES MELT2Y
         SEGDES MELT2Z
         SEGDES MEVUV1
         SEGDES MEVUV2
      ENDIF
C
      SEGDES MELAL1
      SEGDES MELAL2
C
      SEGDES MELRN1
      SEGDES MELRN2
C
      SEGDES MELPN1
      SEGDES MELPN2
C
C
C**** Destruction du MELNTI correspondance local/global
C
      SEGSUP MLENT1
C
 9999 CONTINUE
      if (mcham1.ne.0) segdes mcham1
C
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

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