C CLI122    SOURCE    OF166741  24/12/13    21:15:13     12097          
      SUBROUTINE CLI122(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               :  CLI122
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

      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,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY
     &     ,RF,PF,UXF,UYF
     &     ,UNC,UNF,ASONC,ASONF,ASON
*     &     ,UTF,SF
     &     ,UTC,SC
     &     ,GM1,USGM1,DSGM1,G1,G3,ASON2,S,UT,UN,RHO,P,UX,UY
     &     ,DUNDG3,DASDG3,DRHDG3,DPDG3,DRHDS,DPDS
*     &     ,CELL,EPS,CACCA
     &     ,DUXDG3,DUYDG3,DUXDUT,DUYDUT
     &     ,DFRDG3,DFRDS,DFMXG3,DFMXS,DFMXUT,DFMYG3,DFMYS,DFMYUT
     &     ,DFEDG3,DFEDS,DFEDUT
     &     ,DG3DR,DG3DP,DG3DUX,DG3DUY,DSDR,DSDP,DUTDUX,DUTDUY,COEF
     &     ,DRORO,DROUX,DROUY,DROP
     &     ,DUXRO,DUXUX,DUXUY,DUXP
     &     ,DUYRO,DUYUX,DUYUY,DUYP
     &     ,DPRO,DPUX,DPUY,DPP
     &     ,COEF1,COEF2,COEF3
      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 = 16
      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(1)
      IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
      IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
      IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
      IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
      IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
C
      SEGDES MLMOTS
      MLMOTS=ILIINC
      SEGACT MLMOTS
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(2)
      IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
      IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
      IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
      IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
C
      SEGDES MLMOTS
      NBEL = NFAC
      NBSOUS = 1
      NP = 1
      MP = 1
      SEGINI   RR  , RUX , RUY , RRET ,
     &         UXR , UXUX , UXUY , UXRET ,
     &         UYR , UYUX , UYUY , UYRET ,
     &         RETR , RETUX , RETUY , 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) = RRET
      IMATRI.LIZAFM(1,5) = UXR
      IMATRI.LIZAFM(1,6) = UXUX
      IMATRI.LIZAFM(1,7) = UXUY
      IMATRI.LIZAFM(1,8) = UXRET
      IMATRI.LIZAFM(1,9) = UYR
      IMATRI.LIZAFM(1,10) = UYUX
      IMATRI.LIZAFM(1,11) = UYUY
      IMATRI.LIZAFM(1,12) = UYRET
      IMATRI.LIZAFM(1,13) = RETR
      IMATRI.LIZAFM(1,14) = RETUX
      IMATRI.LIZAFM(1,15) = RETUY
      IMATRI.LIZAFM(1,16) = 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=MPNORM.VPOCHA(NLF,1)
         CNY=MPNORM.VPOCHA(NLF,2)
         CTX=-1.0D0*CNY
         CTY=CNX
C        Variables au centre
         RC=MPRC.VPOCHA(NLC,1)
         PC=MPPC.VPOCHA(NLC,1)
         UXC=MPVC.VPOCHA(NLC,1)
         UYC=MPVC.VPOCHA(NLC,2)
         GAMC=MPGAMC.VPOCHA(NLC,1)
C        Variables à la face
         RF=MPLIM.VPOCHA(NLCB,1)
         UXF=MPLIM.VPOCHA(NLCB,2)
         UYF=MPLIM.VPOCHA(NLCB,3)
         PF=MPLIM.VPOCHA(NLCB,IDIM+2)
C
C******* On calcule UN, UT ASON, S
C
         UNC=(UXC*CNX)+(UYC*CNY)
         UTC=(UXC*CTX)+(UYC*CTY)
         UNF=(UXF*CNX)+(UYF*CNY)
C         UTF=(UXF*CTX)+(UYF*CTY)
C
         ASONC=(GAMC*PC/RC)**0.5D0
         ASONF=(GAMC*PF/RF)**0.5D0
C
         SC=PC/(RC**GAMC)
C         SF=PF/(RF**GAMC)
C
C******* Densite, vitesse, pression sur le bord
C
         GM1=(GAMC-1.0D0)
         USGM1=1.0D0/GM1
         DSGM1=2.0D0*USGM1
         G1=UNF-(DSGM1*ASONF)
         G3=UNC+(DSGM1*ASONC)
         UN=0.5D0*(G1+G3)
         ASON=(0.5D0*(G3-G1))
         ASON=ASON/DSGM1
         ASON2=ASON*ASON
         S=SC
         UT=UTC
         RHO=ASON2/(GAMC*S)
         RHO=RHO**USGM1
         P=RHO*ASON2/GAMC
         UX=(UN*CNX)+(UT*CTX)
         UY=(UN*CNY)+(UT*CTY)
C
C******* Derivatives
C
         DUNDG3=0.5D0
         DASDG3=0.5D0/DSGM1
         DRHDG3=GAMC*S
         DRHDG3=1.0D0/DRHDG3
         DRHDG3=DRHDG3**USGM1
         DRHDG3=DRHDG3*DSGM1
         DRHDG3=DRHDG3*(ASON**((3.0D0-GAMC)/(GAMC-1.0D0)))
         DRHDG3=DRHDG3*DASDG3
         DRHDS=-1.0D0*USGM1*RHO/S
         DPDG3=((ASON2/GAMC)*DRHDG3)+(((2*ASON*RHO)/GAMC)*DASDG3)
         DPDS=(ASON2/GAMC)*DRHDS
CC
CC******* Test
CC
CC        ...DG3
C         EPS=1.0D-6
C         G3=G3*(1+EPS)
C         CELL=UN
C         UN=0.5D0*(G1+G3)
C         write(*,*) DUNDG3, ((UN - CELL)/(EPS*G3))
C         CELL=ASON
C         ASON=(0.5D0*(G3-G1))
C         ASON=ASON/DSGM1
C         write(*,*) DASDG3, ((ASON - CELL)/(EPS*G3))
C         ASON2=ASON*ASON
C         S=SC
C         UT=UTC
C         CELL=RHO
C         RHO=ASON2/(GAMC*S)
C         RHO=RHO**USGM1
C         write(*,*) DRHDG3, ((RHO - CELL)/(EPS*G3))
C         CELL=P
C         P=RHO*ASON2/GAMC
C         write(*,*) DPDG3, ((P - CELL)/(EPS*G3))
CC
CC******* Test
CC
CC        ...DS
C         EPS=1.0D-6
C         S=S*(1+EPS)
C         CELL=RHO
C         RHO=ASON2/(GAMC*S)
C         RHO=RHO**USGM1
C         write(*,*) DRHDS, ((RHO - CELL)/(EPS*S))
C         CELL=P
C         P=RHO*ASON2/GAMC
C         write(*,*) DPDS, ((P - CELL)/(EPS*S))
CC
CC************************************************************
CC
         DUXDG3=DUNDG3*CNX
         DUYDG3=DUNDG3*CNY
         DUXDUT=CTX
         DUYDUT=CTY
C
         DFRDG3=(DRHDG3*UN)+(RHO*DUNDG3)
         DFRDS=(DRHDS*UN)
         DFMXG3=(DRHDG3*UN*UX)+(RHO*DUNDG3*UX)+
     &        (RHO*UN*DUXDG3)+(DPDG3*CNX)
         DFMXS=(DRHDS*UN*UX)+(DPDS*CNX)
         DFMXUT=(RHO*UN*DUXDUT)
         DFMYG3=(DRHDG3*UN*UY)+(RHO*DUNDG3*UY)+
     &        (RHO*UN*DUYDG3)+(DPDG3*CNY)
         DFMYS=(DRHDS*UN*UY)+(DPDS*CNY)
         DFMYUT=(RHO*UN*DUYDUT)
         DFEDG3=(DUNDG3*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG3) +
     &        (0.5D0*DRHDG3*UN*((UN*UN)+(UT*UT))) +
     &        (0.5D0*RHO*DUNDG3*((UN*UN)+(UT*UT))) +
     &        (RHO*UN*UN*DUNDG3)
         DFEDS=(UN*GAMC*USGM1*DPDS) +
     &        (0.5D0*DRHDS*UN*((UN*UN)+(UT*UT)))
         DFEDUT=RHO*UN*UT
C
C******* Jacobian with respect to primitive variables
C
         DG3DR=-1*USGM1*ASONC/RC
         DG3DP=USGM1*ASONC/PC
         DG3DUX=CNX
         DG3DUY=CNY
         DSDR=-1*GAMC*S/RC
         DSDP=S/PC
         DUTDUX=CTX
         DUTDUY=CTY
C
         COEF=-1*SURF/VOLU
C
         DRORO=((DFRDG3*DG3DR)+(DFRDS*DSDR))*COEF
         DROUX=(DFRDG3*DG3DUX)*COEF
         DROUY=(DFRDG3*DG3DUY)*COEF
         DROP=((DFRDG3*DG3DP)+(DFRDS*DSDP))*COEF
C
         DUXRO=((DFMXG3*DG3DR)+(DFMXS*DSDR))*COEF
         DUXUX=((DFMXG3*DG3DUX)+(DFMXUT*DUTDUX))*COEF
         DUXUY=((DFMXG3*DG3DUY)+(DFMXUT*DUTDUY))*COEF
         DUXP=((DFMXG3*DG3DP)+(DFMXS*DSDP))*COEF
C
         DUYRO=((DFMYG3*DG3DR)+(DFMYS*DSDR))*COEF
         DUYUX=((DFMYG3*DG3DUX)+(DFMYUT*DUTDUX))*COEF
         DUYUY=((DFMYG3*DG3DUY)+(DFMYUT*DUTDUY))*COEF
         DUYP=((DFMYG3*DG3DP)+(DFMYS*DSDP))*COEF
CC
         DPRO=((DFEDG3*DG3DR)+(DFEDS*DSDR))*COEF
         DPUX=((DFEDG3*DG3DUX)+(DFEDUT*DUTDUX))*COEF
         DPUY=((DFEDG3*DG3DUY)+(DFEDUT*DUTDUY))*COEF
         DPP=((DFEDG3*DG3DP)+(DFEDS*DSDP))*COEF
CC
CC******* Jacobian with respect to conservative variables
CC
         IF(IJAC.EQ.1)THEN

            COEF1=-1.0D0*UXC/RC
            COEF2=-1.0D0*UYC/RC
            COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
C
            RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
     $           *COEF3)
            RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
            RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
            RRET.AM(IFAC,1,1)=GM1*DROP
C
            UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
     $           *COEF3)
            UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
            UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
            UXRET.AM(IFAC,1,1)=GM1*DUXP
C
            UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
     $           *COEF3)
            UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
            UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
            UYRET.AM(IFAC,1,1)=GM1*DUYP
C
            RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
     $           *COEF3)
            RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
            RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*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
            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
            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
            UYRET.AM(IFAC,1,1)=DUYP
C
            RETR.AM(IFAC,1,1)=DPRO
            RETUX.AM(IFAC,1,1)=DPUX
            RETUY.AM(IFAC,1,1)=DPUY
            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 , RRET ,
     &         UXR , UXUX , UXUY , UXRET ,
     &         UYR , UYUX , UYUY , UYRET ,
     &         RETR , RETUX , RETUY , RETRET
C
 9999 CONTINUE
      RETURN
      END