C CLI181 SOURCE CB215821 20/11/25 13:20:21 10792 SUBROUTINE CLI181(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : CLI171 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, & MPRES.MPOVAL, MPRLI.MPOVAL 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,ICHRES,ICHRLI,ICEL,NFAC,IFAC & ,NGF,NGC,NLF,NLC,NLCB REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1 & ,CT2X,CT2Y,CT2Z,UTF,UT2F & ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ & ,RHOC,UXC,UYC,UZC,UNC,CC,ACEL,BCEL,CCEL 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) CALL LICHT(ICHRES,MPRES,TYPE,ICEL) CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) C C SEGACT *MOD C SEGACT *MOD 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) CNZ=0.0D0 CTZ=0.0D0 CT2X=0.0D0 CT2Y=0.0D0 CT2Z=0.0D0 UZC=0.0D0 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) IF(IDIM.EQ.2)THEN CTX=-1.0D0*CNY CTY=CNX ELSE 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) ENDIF GAMC=MPGAMC.VPOCHA(NLC,1) GM1=GAMC-1.0D0 USGM1=1.0D0/GM1 C Variables au centre PC=MPPC.VPOCHA(NLC,1) RHOC=MPRC.VPOCHA(NLC,1) UXC=MPVC.VPOCHA(NLC,1) UYC=MPVC.VPOCHA(NLC,2) IF(IDIM.EQ.3) UZC=MPVC.VPOCHA(NLC,3) UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) CC=GAMC*PC/RHOC CC=CC**0.5D0 C Variables à la face RHOUF=MPLIM.VPOCHA(NLCB,1) PSRF=MPLIM.VPOCHA(NLCB,2) UTF=0.0D0 UT2F=0.0D0 C C******* Variables à l'interface C ACEL=CC/GAMC BCEL=ACEL - UNC CCEL=(RHOUF / PC) * PSRF P=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) P=P/(2*ACEL) P=P*PC RHO=P/PSRF UN=RHOUF/RHO UT=UTF UT2=UT2F C C******* On calcule U C UX=UN*CNX+UT*CTX+UT2*CT2X UY=UN*CNY+UT*CTY+UT2*CT2Y UZ=UN*CNZ+UT*CTZ+UT2*CT2Z C ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) C C******* Densite, vitesse, pression sur le bord C MPRLI.VPOCHA(NLCB,1)=RHO MPRLI.VPOCHA(NLCB,2)=UX MPRLI.VPOCHA(NLCB,3)=UY IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ MPRLI.VPOCHA(NLCB,IDIM+2)=P C C C******* Residuum (son SPG a le meme ordre que MELEFC) C MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMC*USGM1*PSRF)+ECIN)) & *SURF/VOLU 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 SEGDES MPRES SEGDES MPRLI C 9999 CONTINUE RETURN END