C CLI183    SOURCE    OF166741  24/12/13    21:15:28     12097          
      SUBROUTINE CLI183(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO,
     &     ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  CLI183
C
C DESCRIPTION       :  Subroutine appellée par CLIM11
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C APPELES (Calcul)  :
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMELEME
      POINTEUR MELEFC.MELEME
-INC SMLENTI
      POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
-INC SMCHPOI
      POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
     &     MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL
-INC SMMATRIK
      POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
     &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
     &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
     &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM,
     &         RUZ.IZAFM, UXUZ.IZAFM, UYUZ.IZAFM, RETUZ.IZAFM,
     &         UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZRET.IZAFM,
     &         UZUZ.IZAFM
C
      INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
     &     ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
     &     ,NGF,NGC,NLF,NLC,NLCB
     &     ,ILIINC,ILIINP,IJAC
     &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
      REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,GM1
     &     ,RC,UXC,UYC,UZC,CC,UNC
     &     ,PC,PSRF,RHOUF,P,RHO,UN,ACEL,BCEL,CCEL,PSTAR,UX,UY,UZ,ECIN
     &     ,DADR,DADP,DBDR,DBDP,DBDUX,DBDUY,DBDUZ,DCDP
     &     ,DPSDA,DPSDB,DPSDC,DPDR,DPDP,DPDUX,DPDUY,DPDUZ
     &     ,DUXDP,DUYDP,DUZDP,DECINP,DF2DP,DF3DP,DF4DP,DF5DP
     &     ,DRORO,DROUX,DROUY,DROP
     &     ,DUXRO,DUXUX,DUXUY,DUXP
     &     ,DUYRO,DUYUX,DUYUY,DUYP
     &     ,DPRO,DPUX,DPUY,DPP
     &     ,COEF1,COEF2,COEF3,COEF,COEF4
     &     ,DROUZ,DUXUZ,DUYUZ,DPUZ
     &     ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP
C     &     ,YCAC,YCAC2,YCAC3,YCAC4,XCAC,F1,F2,F3,F4,F5,USGM1
      CHARACTER*(8) TYPE
C
C
C**** KRIPAD pour la correspondance global/local
C
      CALL KRIPAD(MELEMC,MLEMC)
C     SEGINI MLEMC
      CALL KRIPAD(MELECB,MLEMCB)
C     SEGINI MLEMCB
      CALL KRIPAD(MELEMF,MLEMF)
C     SEGINI MLEMF
C
C**** CHPOINTs de la table DOMAINE
C
      CALL LICHT(INORM,MPNORM,TYPE,ICEL)
      CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
      CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
C
C**** LICHT active les MPOVALs en *MOD
C
C     SEGACT MPNORM*MOD
C     SEGACT MPOVSU*MOD
C     SEGACT MPOVOL*MOD
C
C
C**** CHPOINTs des variables
C
      CALL LICHT(IROC,MPRC,TYPE,ICEL)
      CALL LICHT(IVITC,MPVC,TYPE,ICEL)
      CALL LICHT(IPC,MPPC,TYPE,ICEL)
      CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
      CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
C
C     SEGACT *MOD
C     SEGACT *MOD
C     SEGACT *MOD
C     SEGACT *MOD
C     SEGACT *MOD
C
C
C**** Boucle sur le face pour le calcul des invariants de
C     Riemann et du flux
C
      SEGACT MELEFC
      NFAC=MELEFC.NUM(/2)
C
C**** Objet MATRIK
C
      NRIGE = 7
      NMATRI = 1
      NKID = 9
      NKMT = 7
C
      SEGINI MATRIK
      IJACO = MATRIK
      MATRIK.IRIGEL(1,1) = MELRES
      MATRIK.IRIGEL(2,1) = MELRES
C
C**** Matrice non symetrique
C
      MATRIK.IRIGEL(7,1) = 2
C
      NBME = 25
      NBSOUS = 1
      SEGINI IMATRI
      IF(IJAC.EQ.1)THEN
         MLMOTS=ILIINC
      ELSEIF(IJAC.EQ.2)THEN
         MLMOTS=ILIINP
      ENDIF
      SEGACT MLMOTS
      MATRIK.IRIGEL(4,1) = IMATRI
C
      IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(5) = MLMOTS.MOTS(5)
C
      IMATRI.LISPRI(6) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(7) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(8) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(9) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(10) = MLMOTS.MOTS(5)
C
      IMATRI.LISPRI(11) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(12) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(13) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(14) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(15) = MLMOTS.MOTS(5)
C
      IMATRI.LISPRI(16) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(17) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(18) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(19) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(20) = MLMOTS.MOTS(5)
C
      IMATRI.LISPRI(21) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(22) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(23) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(24) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(25) = MLMOTS.MOTS(5)
C
      SEGDES MLMOTS
      MLMOTS=ILIINC
      SEGACT MLMOTS
C
C
      IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
      IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
      IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
      IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
      IMATRI.LISDUA(5) = MLMOTS.MOTS(1)
C
      IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(9) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(10) = MLMOTS.MOTS(2)
C
      IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(13) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(14) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(15) = MLMOTS.MOTS(3)
C
      IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(17) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(18) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(19) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(20) = MLMOTS.MOTS(4)
C
      IMATRI.LISDUA(21) = MLMOTS.MOTS(5)
      IMATRI.LISDUA(22) = MLMOTS.MOTS(5)
      IMATRI.LISDUA(23) = MLMOTS.MOTS(5)
      IMATRI.LISDUA(24) = MLMOTS.MOTS(5)
      IMATRI.LISDUA(25) = MLMOTS.MOTS(5)
C
      SEGDES MLMOTS
      NBEL = NFAC
      NBSOUS = 1
      NP = 1
      MP = 1
      SEGINI   RR  , RUX , RUY , RUZ ,RRET ,
     &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
     &         UYR , UYUX , UYUY , UYUZ , UYRET ,
     &         UZR , UZUX , UZUY , UZUZ , UZRET ,
     &         RETR , RETUX , RETUY, RETUZ , RETRET
C
C**** Duale = IMATRI.LISDUA(1) = 'RN'
C     Primale = IMATRI.LISPRI(1) = 'RN'
C     -> IMATRI.LIZAFM(1,1) = RR
C
      IMATRI.LIZAFM(1,1) = RR
      IMATRI.LIZAFM(1,2) = RUX
      IMATRI.LIZAFM(1,3) = RUY
      IMATRI.LIZAFM(1,4) = RUZ
      IMATRI.LIZAFM(1,5) = RRET
C
      IMATRI.LIZAFM(1,6) = UXR
      IMATRI.LIZAFM(1,7) = UXUX
      IMATRI.LIZAFM(1,8) = UXUY
      IMATRI.LIZAFM(1,9) = UXUZ
      IMATRI.LIZAFM(1,10) = UXRET
C
      IMATRI.LIZAFM(1,11) = UYR
      IMATRI.LIZAFM(1,12) = UYUX
      IMATRI.LIZAFM(1,13) = UYUY
      IMATRI.LIZAFM(1,14) = UYUZ
      IMATRI.LIZAFM(1,15) = UYRET
C
      IMATRI.LIZAFM(1,16) = UZR
      IMATRI.LIZAFM(1,17) = UZUX
      IMATRI.LIZAFM(1,18) = UZUY
      IMATRI.LIZAFM(1,19) = UZUZ
      IMATRI.LIZAFM(1,20) = UZRET
C
      IMATRI.LIZAFM(1,21) = RETR
      IMATRI.LIZAFM(1,22) = RETUX
      IMATRI.LIZAFM(1,23) = RETUY
      IMATRI.LIZAFM(1,24) = RETUZ
      IMATRI.LIZAFM(1,25) = RETRET
C
      SEGDES MATRIK
      SEGDES IMATRI
C
C**** Fin definition MATRIK
C
      DO IFAC=1,NFAC,1
         NGF=MELEFC.NUM(1,IFAC)
         NGC=MELEFC.NUM(2,IFAC)
         NLF=MLEMF.LECT(NGF)
         NLC=MLEMC.LECT(NGC)
         NLCB=MLEMCB.LECT(NGF)
         VOLU=MPVOL.VPOCHA(NLC,1)
         SURF=MPSURF.VPOCHA(NLF,1)
C        In CASTEM les normales sont sortantes
         CNX=-1*MPNORM.VPOCHA(NLF,1)
         CNY=-1*MPNORM.VPOCHA(NLF,2)
         CNZ=-1*MPNORM.VPOCHA(NLF,3)
C        Variables au centre
         RC=MPRC.VPOCHA(NLC,1)
         PC=MPPC.VPOCHA(NLC,1)
         UXC=MPVC.VPOCHA(NLC,1)
         UYC=MPVC.VPOCHA(NLC,2)
         UZC=MPVC.VPOCHA(NLC,3)
         GAMC=MPGAMC.VPOCHA(NLC,1)
         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
         CC=GAMC*PC/RC
         CC=CC**0.5D0
         GM1=GAMC-1.0D0
C        Variables à la face
         RHOUF=MPLIM.VPOCHA(NLCB,1)
         PSRF=MPLIM.VPOCHA(NLCB,2)
C
C******* Variables à l'interface
C
         ACEL=CC/GAMC
         BCEL=ACEL - UNC
         CCEL=(RHOUF / PC) * PSRF
         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
         PSTAR=PSTAR/(2*ACEL)
         P=PSTAR*PC
         RHO=P/PSRF
         UN=RHOUF/RHO
         UX=UN*CNX
         UY=UN*CNY
         UZ=UN*CNZ
         ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
C
C******* Derivatives of ACEL, BCEL, CCEL with respect to the
C        variables at centers
C
         DADR = -0.5D0*CC/(RC*GAMC)
         DADP =  0.5D0*CC/(PC*GAMC)
         DBDR = DADR
         DBDP = DADP
         DBDUX = -1*CNX
         DBDUY = -1*CNY
         DBDUZ = -1*CNZ
         DCDP = -1*CCEL/PC
C
C******* Derivatives of PSTAR with respect to ACEL,BCEL,CCEL
C
         DPSDA = -1*(PSTAR*PSTAR)/((2*ACEL*PSTAR)-BCEL)
         DPSDB = PSTAR/((2*ACEL*PSTAR)-BCEL)
         DPSDC = 1/((2*ACEL*PSTAR)-BCEL)
C
C******* Derivatives of PC*PSTAR with respect to RC,PC,UXC,UYC
C
         DPDR=(DPSDA*DADR)+(DPSDB*DBDR)
         DPDR=DPDR*PC
         DPDP=(DPSDA*DADP)+(DPSDB*DBDP)+(DPSDC*DCDP)
         DPDP=(DPDP*PC)+PSTAR
         DPDUX=(DPSDB*DBDUX)*PC
         DPDUY=(DPSDB*DBDUY)*PC
         DPDUZ=(DPSDB*DBDUZ)*PC
CC
CC******* Test 1
CC
CC        We check dpdp
CC
C         YCAC=P
C         XCAC=PC
C         PC=PC*(1+1.0D-4)
C         CC=GAMC*PC/RC
C         CC=CC**0.5D0
CC
C         ACEL=CC/GAMC
C         BCEL=ACEL - UNC
C         CCEL=(RHOUF / PC) * PSRF
C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
C         PSTAR=PSTAR/(2*ACEL)
C         P=PSTAR*PC
C         write(*,*) ((P - YCAC)/(PC - XCAC)), DPDP
CC
CC        We check dpdr
CC
C         YCAC=P
C         XCAC=RC
C         RC=RC*(1+1.0D-4)
C         CC=GAMC*PC/RC
C         CC=CC**0.5D0
CC
C         ACEL=CC/GAMC
C         BCEL=ACEL - UNC
C         CCEL=(RHOUF / PC) * PSRF
C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
C         PSTAR=PSTAR/(2*ACEL)
C         P=PSTAR*PC
C         write(*,*) ((P - YCAC)/(RC - XCAC)), DPDR
CC
CC        We check dpdux
CC
C         YCAC=P
C         XCAC=UXC
C         UXC=UXC*(1+1.0D-4)
C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
C         CC=GAMC*PC/RC
C         CC=CC**0.5D0
CC
C         ACEL=CC/GAMC
C         BCEL=ACEL - UNC
C         CCEL=(RHOUF / PC) * PSRF
C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
C         PSTAR=PSTAR/(2*ACEL)
C         P=PSTAR*PC
C         write(*,*) ((P - YCAC)/(UXC - XCAC)), DPDUX
CC
CC        We check dpduy
CC
C         YCAC=P
C         XCAC=UYC
C         UYC=UYC*(1+1.0D-4)
C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
C         CC=GAMC*PC/RC
C         CC=CC**0.5D0
CC
C         ACEL=CC/GAMC
C         BCEL=ACEL - UNC
C         CCEL=(RHOUF / PC) * PSRF
C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
C         PSTAR=PSTAR/(2*ACEL)
C         P=PSTAR*PC
C         write(*,*) ((P - YCAC)/(UYC - XCAC)), DPDUY
CC
CC        We check dpduz
CC
C         YCAC=P
C         XCAC=UZC
C         UZC=UZC*(1+1.0D-4)
C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
C         CC=GAMC*PC/RC
C         CC=CC**0.5D0
CC
C         ACEL=CC/GAMC
C         BCEL=ACEL - UNC
C         CCEL=(RHOUF / PC) * PSRF
C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
C         PSTAR=PSTAR/(2*ACEL)
C         P=PSTAR*PC
C         write(*,*) ((P - YCAC)/(UZC - XCAC)), DPDUZ
CC
CC
CC******* Fin test 1
C
C
C******* The interfacial state is thus given by
C        RHOUF,PSRF,P and UT (UT=0), UT2 (UT2=0)
C        Let us now compute the derivative of the residuum with
C        respect to P.
C        The residuum is given by
C
C        F1=RHOUF*SURF/VOLU
C        F2=(RHOUF*UX+P*CNX)*SURF/VOLU
C        F3=(RHOUF*UY+P*CNY)*SURF/VOLU
C        F4=(RHOUF*UZ+P*CNZ)*SURF/VOLU
C        F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*SURF/VOLU
C
C        In these expression: UX, UY, P and ECIN depends on P
C
         COEF=SURF/VOLU
         DUXDP=-1*UX/P
         DUYDP=-1*UY/P
         DUZDP=-1*UZ/P
         DECINP=-2*ECIN/P
         DF2DP=((RHOUF*DUXDP)+CNX)*COEF
         DF3DP=((RHOUF*DUYDP)+CNY)*COEF
         DF4DP=((RHOUF*DUZDP)+CNZ)*COEF
         DF5DP=(RHOUF*DECINP)*COEF
CC
CC******* Test 2
CC
CC        We check DF2P
CC
C         USGM1=1/GM1
C         F2=(RHOUF*UX+P*CNX)*COEF
C         F3=(RHOUF*UY+P*CNY)*COEF
C         F4=(RHOUF*UZ+P*CNZ)*COEF
C         F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
CC
C         YCAC=F2
C         YCAC2=F3
C         YCAC3=F4
C         YCAC4=F5
C         XCAC=P
C         P=P*(1+1.0D-4)
C         RHO=P/PSRF
C         UN=RHOUF/RHO
C         UX=UN*CNX
C         UY=UN*CNY
C         UZ=UN*CNZ
C         ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
C
C         F2=(RHOUF*UX+P*CNX)*COEF
C         F3=(RHOUF*UY+P*CNY)*COEF
C         F4=(RHOUF*UZ+P*CNZ)*COEF
C         F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
C         write(*,*) ((F2 -YCAC)/(P-XCAC)),DF2DP
C         write(*,*) ((F3 -YCAC2)/(P-XCAC)),DF3DP
C         write(*,*) ((F4 -YCAC3)/(P-XCAC)),DF4DP
C         write(*,*) ((F5 -YCAC4)/(P-XCAC)),DF5DP
C
C******* Fin test 2
C
C
C******* Jacobian with respect to primitive variables
C
C
C        DF1D...
C
         DRORO=0.0D0
         DROUX=0.0D0
         DROUY=0.0D0
         DROUZ=0.0D0
         DROP=0.0D0
C
C        DF5D...
C
         DPRO=DF5DP*DPDR
         DPUX=DF5DP*DPDUX
         DPUY=DF5DP*DPDUY
         DPUZ=DF5DP*DPDUZ
         DPP=DF5DP*DPDP
C
C        DF2D...
C
         DUXRO=DF2DP*DPDR
         DUXUX=DF2DP*DPDUX
         DUXUY=DF2DP*DPDUY
         DUXUZ=DF2DP*DPDUZ
         DUXP =DF2DP*DPDP
C
C        DF3D
C
         DUYRO=DF3DP*DPDR
         DUYUX=DF3DP*DPDUX
         DUYUY=DF3DP*DPDUY
         DUYUZ=DF3DP*DPDUZ
         DUYP =DF3DP*DPDP
C
C        DF4D
C
         DUZRO=DF4DP*DPDR
         DUZUX=DF4DP*DPDUX
         DUZUY=DF4DP*DPDUY
         DUZUZ=DF4DP*DPDUZ
         DUZP =DF4DP*DPDP
C
C******* Jacobian with respect to conservative variables
C
         IF(IJAC.EQ.1)THEN
            GM1=GAMC-1.0D0
C
            COEF1=-1.0D0*UXC/RC
            COEF2=-1.0D0*UYC/RC
            COEF3=-1.0D0*UZC/RC
            COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC))
C
            RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ
     $           *COEF3)+(DROP*COEF4)
            RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
            RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
            RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP)
            RRET.AM(IFAC,1,1)=GM1*DROP
C
            UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ
     $           *COEF3)+(DUXP*COEF4)
            UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
            UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
            UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP)
            UXRET.AM(IFAC,1,1)=GM1*DUXP
C
            UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ
     $           *COEF3)+(DUYP*COEF4)
            UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
            UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
            UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP)
            UYRET.AM(IFAC,1,1)=GM1*DUYP
C
            UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ
     $           *COEF3)+(DUZP*COEF4)
            UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP)
            UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP)
            UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP)
            UZRET.AM(IFAC,1,1)=GM1*DUZP
C
            RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ
     $           *COEF3)+(DPP*COEF4)
            RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
            RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
            RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP)
            RETRET.AM(IFAC,1,1)=GM1*DPP
C
         ELSEIF(IJAC.EQ.2)THEN
            RR.AM(IFAC,1,1)=DRORO
            RUX.AM(IFAC,1,1)=DROUX
            RUY.AM(IFAC,1,1)=DROUY
            RUZ.AM(IFAC,1,1)=DROUZ
            RRET.AM(IFAC,1,1)=DROP
C
            UXR.AM(IFAC,1,1)=DUXRO
            UXUX.AM(IFAC,1,1)=DUXUX
            UXUY.AM(IFAC,1,1)=DUXUY
            UXUZ.AM(IFAC,1,1)=DUXUZ
            UXRET.AM(IFAC,1,1)=DUXP
C
            UYR.AM(IFAC,1,1)=DUYRO
            UYUX.AM(IFAC,1,1)=DUYUX
            UYUY.AM(IFAC,1,1)=DUYUY
            UYUZ.AM(IFAC,1,1)=DUYUZ
            UYRET.AM(IFAC,1,1)=DUYP
C
            UZR.AM(IFAC,1,1)=DUZRO
            UZUX.AM(IFAC,1,1)=DUZUX
            UZUY.AM(IFAC,1,1)=DUZUY
            UZUZ.AM(IFAC,1,1)=DUZUZ
            UZRET.AM(IFAC,1,1)=DUZP
C
            RETR.AM(IFAC,1,1)=DPRO
            RETUX.AM(IFAC,1,1)=DPUX
            RETUY.AM(IFAC,1,1)=DPUY
            RETUZ.AM(IFAC,1,1)=DPUZ
            RETRET.AM(IFAC,1,1)=DPP
         ENDIF
      ENDDO
C
      SEGDES MELEFC
C
      SEGSUP MLEMC
      SEGSUP MLEMCB
      SEGSUP MLEMF
C
      SEGDES MPNORM
      SEGDES MPVOL
      SEGDES MPSURF
      SEGDES MPRC
      SEGDES MPPC
      SEGDES MPVC
      SEGDES MPGAMC
      SEGDES MPLIM
C
      SEGDES   RR  , RUX , RUY , RUZ ,RRET ,
     &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
     &         UYR , UYUX , UYUY , UYUZ , UYRET ,
     &         UZR , UZUX , UZUY , UZUZ , UZRET ,
     &         RETR , RETUX , RETUY, RETUZ , RETRET
C
 9999 CONTINUE
      RETURN
      END