C CLI163 SOURCE CB215821 20/11/25 13:20:15 10792 SUBROUTINE CLI163(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 : CLI163 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 C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM, IFICLE, IPREFI C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV 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,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY & ,HTF,SF,UTF,RF,PF,UXF,UYF,GM1,USGM1 & ,UNC,UNF,ECIN,PSRF,DPSRUN,DRDUN,DPDUN,DUNDUX,DUNDUY C & ,CACCA,EPS,CACCA1,CACCA2 & ,VECG(5),VECD(5),NVEC(3),TVEC(3),TVEC2(3) & ,DFDUG(5,5),DFDUD(5,5) & ,DUXDUN,DUYDUN,COEF5,COEF & ,DRORO,DROUX,DROUY,DROP & ,DUXRO,DUXUX,DUXUY,DUXP & ,DUYRO,DUYUX,DUYUY,DUYP & ,DPRO,DPUX,DPUY,DPP & ,COEF1,COEF2,COEF3 & ,CNZ,CTZ,CT2X,CT2Y,CT2Z,UZC,UT2F,UZF,DUZDUN,DUNDUZ & ,DROUZ,DPUZ,DUXUZ,DUYUZ & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP,COEF4 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) CTX=-1*MPNORM.VPOCHA(NLF,4) CTY=-1*MPNORM.VPOCHA(NLF,5) CTZ=-1*MPNORM.VPOCHA(NLF,6) CT2X=-1*MPNORM.VPOCHA(NLF,7) CT2Y=-1*MPNORM.VPOCHA(NLF,8) CT2Z=-1*MPNORM.VPOCHA(NLF,9) 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) GM1=GAMC-1.0D0 USGM1=1.0D0/GM1 C Variables à la face HTF=MPLIM.VPOCHA(NLCB,1) SF=MPLIM.VPOCHA(NLCB,2) UTF=0.0D0 UT2F=0.0D0 C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) UNF=UNC C UXF=UNF*CNX+UTF*CTX+UT2F*CT2X UYF=UNF*CNY+UTF*CTY+UT2F*CT2Y UZF=UNF*CNZ+UTF*CTZ+UT2F*CT2Z C ECIN=0.5D0*((UXF*UXF)+(UYF*UYF)+(UZF*UZF)) PSRF=(GM1/GAMC)*(HTF-ECIN) RF=PSRF/SF RF=RF**(1.0D0/GM1) PF=SF*(RF**GAMC) C C******* Derivative of PF/RF,PF,RF,UXF,UYF with respect to UN C DPSRUN=-1*(GM1/GAMC)*UNC DRDUN=USGM1*RF/PSRF*DPSRUN DPDUN=GAMC*PSRF*DRDUN DUXDUN=CNX DUYDUN=CNY DUZDUN=CNZ C DUNDUX=CNX DUNDUY=CNY DUNDUZ=CNZ C C******* Jacobian with respect to primitive variables C VECG(1)=RF VECG(2)=UXF VECG(3)=UYF VECG(4)=UZF VECG(5)=PF C VECD(1)=RC VECD(2)=UXC VECD(3)=UYC VECD(4)=UZC VECD(5)=PC C NVEC(1)=CNX NVEC(2)=CNY NVEC(3)=CNZ TVEC(1)=CTX TVEC(2)=CTY TVEC(3)=CTZ TVEC2(1)=CT2X TVEC2(2)=CT2Y TVEC2(3)=CT2Z C CALL CONJP4(DFDUG,DFDUD,VECG,VECD,NVEC,TVEC,TVEC2,GAMC) C COEF=SURF/VOLU DRORO=DFDUD(1,1)*COEF COEF5=(DFDUG(1,1)*DRDUN)+(DFDUG(1,2)*DUXDUN)+ & (DFDUG(1,3)*DUYDUN)+(DFDUG(1,4)*DUZDUN)+ & (DFDUG(1,5)*DPDUN) DROUX=(COEF5*DUNDUX+DFDUD(1,2))*COEF DROUY=(COEF5*DUNDUY+DFDUD(1,3))*COEF DROUZ=(COEF5*DUNDUZ+DFDUD(1,4))*COEF DROP=DFDUD(1,5)*COEF C DPRO=DFDUD(5,1)*COEF COEF5=(DFDUG(5,1)*DRDUN)+(DFDUG(5,2)*DUXDUN)+ & (DFDUG(5,3)*DUYDUN)+(DFDUG(5,4)*DUZDUN)+ & (DFDUG(5,5)*DPDUN) DPUX=(COEF5*DUNDUX+DFDUD(5,2))*COEF DPUY=(COEF5*DUNDUY+DFDUD(5,3))*COEF DPUZ=(COEF5*DUNDUZ+DFDUD(5,4))*COEF DPP=DFDUD(5,5)*COEF C DUXRO=DFDUD(2,1)*COEF COEF5=(DFDUG(2,1)*DRDUN)+(DFDUG(2,2)*DUXDUN)+ & (DFDUG(2,3)*DUYDUN)+(DFDUG(2,4)*DUZDUN)+ & (DFDUG(2,5)*DPDUN) DUXUX=(COEF5*DUNDUX+DFDUD(2,2))*COEF DUXUY=(COEF5*DUNDUY+DFDUD(2,3))*COEF DUXUZ=(COEF5*DUNDUZ+DFDUD(2,4))*COEF DUXP =DFDUD(2,5)*COEF C DUYRO=DFDUD(3,1)*COEF COEF5=(DFDUG(3,1)*DRDUN)+(DFDUG(3,2)*DUXDUN)+ & (DFDUG(3,3)*DUYDUN)+(DFDUG(3,4)*DUZDUN)+ & (DFDUG(3,5)*DPDUN) DUYUX=(COEF5*DUNDUX+DFDUD(3,2))*COEF DUYUY=(COEF5*DUNDUY+DFDUD(3,3))*COEF DUYUZ=(COEF5*DUNDUZ+DFDUD(3,4))*COEF DUYP =DFDUD(3,5)*COEF C DUZRO=DFDUD(4,1)*COEF COEF5=(DFDUG(4,1)*DRDUN)+(DFDUG(4,2)*DUXDUN)+ & (DFDUG(4,3)*DUYDUN)+(DFDUG(4,4)*DUZDUN)+ & (DFDUG(4,5)*DPDUN) DUZUX=(COEF5*DUNDUX+DFDUD(4,2))*COEF DUZUY=(COEF5*DUNDUY+DFDUD(4,3))*COEF DUZUZ=(COEF5*DUNDUZ+DFDUD(4,4))*COEF DUZP =DFDUD(4,5)*COEF C 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